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1.  Introduction 

The  effort  to  be  described  in  this  report  was  performed  as  partial  fulfillment  of  two  primary 
objectives:  (1)  perform  computer  simulations  of  charged  particle  transport,  energy  and  charge 
deposition  in  satellite-borne  instrumentation  used  in  research  efforts  of  the  Air  Force  Research 
Laboratory/  Space  Weather  Center  of  Excellence  (AFRL/VSBXR)  to  detect  and  characterize  (by 
type,  energy,  intensity,  etc.)  particles  associated  with  ionizing  radiation  in  space;  (2)  transfer  this 
simulation  capability  to  AFRL/VSBXR  and  provide  advice  to  Air  Force  researchers  on  its  use; 
and  (3)  create  and  install  additional  capabilities  in  existing  Monte  Carlo  transport  programs  to: 

(a)  simulate  a  number  of  source  geometries  encountered  in  the  VSXBR  research  program;  and 

(b)  permit  "observation"  of  individual  electron  track  histories. 

During  this  reporting  period  we  worked  with  the  Monte  Carlo  simulation  programs  listed 
below  at  ARCON  and  provided  assistance  and  guidance  for  their  use  at  AFRL.  The  Monte 
Carlo  transport  simulations  programs  that  were  used  at  both  ARCON  and  AFRL  in  this  effort 
are: 

•  “ITS  3.0  -  Integrated  TIGER  Series  of  Coupled  Electron/Photon  Monte  Carlo  Code 
System”  [1]  -  ACCEPT  -  General  three-dimensional  transport  code 

•  “MCNPX,  Version  2.1.5  -  Monte  Carlo  transport  code  for  neutrons,  photons,  electrons, 
mesons,  protons,  deuterons,  tritons,  3He,  alpha”  [2] 

In  addition  to  the  two  codes  listed  above,  we  also  acquired  a  three  dimensional  geometry  and 
visualization  program,  Sabrina[3],  that  while  written  primarily  for  use  with  the  MCNP  code 
series,  can  also  be  used  for  reading  and  writing  geometry  files  for  ITS/ ACCEPT. 

In  the  following  sections,  we  briefly  discuss  the  computer  programs  listed  above,  some  of 
their  interrelationships,  and  provide  descriptions  and  examples  of  our  application  of  these  codes 
to  the  modeling  of  particle  transport  and  trajectory  tracking  in  the  CEASE[4]  and  HEP[5] 
instruments. 


2.  Electron  Transport  Modeling 

2.1  Electron  Energy  Deposition  Calculations  in  Silicon  Wafers 

Transport  calculations  for  4  MeV  and  6  MeV  electrons  incident  on  rectangular  silicon 
dosimeter  wafers  (0.05cm  x  0.9cm  x  0.9cm).  Twelve  source  geometry  configurations  were 
assumed  for  each  source  energy.  Duplicate  simulation  runs  were  made  with  both  ITS- 
ACCEPT[1]  and  MCNPX[2].  The  result  of  performing  these  calculations  accomplished  two 
objectives:  1)  provide  a  set  of  input  files  for  both  simulation  programs  that  could  be  modified,  if 
desired,  and  used  by  AFRL  personnel  for  performing  these  and  similar  simulations;  and  2) 
compare  the  relative  advantages  and  disadvantages  of  the  ACCEPT  and  MCNPX  codes  for 
electron  transport.  The  input  files  were  also  set  up  to  produce  electron  pulse-height  spectra. 
We  provided  interpretation  of  the  pulse-height  spectra  results  for  both  codes,  the  presentations  of 
which  are  formatted  differently,  and  showed  for  all  practical  purposes,  the  equivalence  of  their 
answers. 

For  all  source  configurations  and  both  source  energies,  the  Monte  Carlo  runs  were  made 
using  200,000  case  histories.  The  source  geometries  consisted  of:  normally  incident  electron 
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beams  (or  point  sources);  point  isotropic  sources;  disk  sources-normal  incidence;  disk  sources- 
isotropic  incidence.  All  sources  were  located  on  die  wafer  surfaces,  either  on  the  0.9cm  x  0.9cm 
surface  (Fig. la)  or  on  the  0.05cm  x  0.9cm  surface  (Fig.  lb).  The  input  and  output  files  for  all  24 
Monte  Carlo  runs  were  provided  to  AFRL.  Default  values  for  the  electron  low  energy  cut-off 
were  used  with  both  ACCEPT  ((kOSE^^)  and  MCNPX  (1.0  keV).  Since  the  default  value  for 
the  MCNPX  cut-off  energy  was  set  much  lower  than  the  ACCEPT  value,  the  run  times  for 
MCNPX  (-1  hr)  far  exceeded  those  for  ACCEPT  (~0.5  min)  by  two  orders  of  magnitude.  When 
the  same  electron  cut-off  energy  was  used  in  MCNPX,  the  run  time  was  found  to  be  a  factor  of 
1.5  greater  than  that  required  for  ACCEPT.  With  the  current  version  of  ACCEPT,  the  lowest 
electron  cut-off  energy  allowed  by  the  code  is  24.5  keV.  When  the  program  was  run  with  this 
cut-off,  the  run  time  for  200000  histories  increased  to  1.17  minutes  with  no  significant  change  in 
the  results.  To  achieve  the  low  energy  cut-off  value  of  1  keV,  it  would  have  been  necessary  to 
use  ACCEPTP  and  XGENP,  the  P-code  versions  of  ACCEPT  and  XGEN,  containing  low-energy 
electron  physics.  ACCEPT  energy  deposition  results  are  shown  in  Figs.2-6  for  6  MeV  sources. 
Fig.  2  displays  the  total  energy  deposited  in  the  silicon  wafer  shown  in  Fig.  la  for  the  eight  source 
configurations  described  and  labeled  in  Table  1. 


Figure  1.  Electron  sources  incident  on  silicon  dosimeter  wafer 
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Table  1. 

Source  Configurations  for  Transport  Simulation  of  4.0  and  6.0  MeV  Electrons  in  Silicon 


Electron  Soure 

_ Configuration 

(1)  Single  Beam,  Normal 
Incidence  at  (.45,. 45,0.) 


(2)  Disk  Source, 

Rad.  =  0.1cm, 

Normal  Incidence  centered 
at  (.45,.45,0.) 

(3)  Disk  Source, 

Radius  =  0.2cm, 

Normal  Incidence  centered 
at  (.45, .45,0.) 

(4)  Disk  Source, 

Radius  =  0.449cm, 

Normal  Incidence  centered 
at  (.45, .45,0.) 

(5)  Point  Isotropic,  45° 
cone  centered  at 
(.45, .45,0.) 


(6)  Disk  Source, 

Rad.  =  0.1cm, 

Isotropic  45°  cones 
centered  at  (.45, .45,0.) 

(7)  Disk  Source, 

Rad.  =  0.2cm, 

Isotropic  45°  cones 
centered  at  (.45, .45,0.) 

(8)  Disk  Source, 

Rad.  =  0.449cm, 
Isotropic  45°  cones 
centered  at  (.45, .45,0.) 


Source  Geometry 


The  choice  of  200000  histories  resulted  in  poor  statistics  for  the  point  sources,  except  in  the 
immediate  vicinity  of  the  source  point.  The  statistics  were  much  improved,  however, 
everywhere  in  the  silicon  wafer  (~l%-5%  estimated  standard  error)  with  the  use  of  spatially 
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uniform  disk  sources.  The  number  of  histories  (200000)  was  chosen  as  an  expedient  to  ensure 
input  file  correctness.  The  run  files  corresponding  to  the  source  configurations  shown  in  Table  1 
were  turned  over  to  AFRL  for  production  runs. 
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Normal  Beam  at  (.45,  .45, 0.)  Normal  Disk,  R=0.1  at  (.45,  .45, 0.)  Normal  Disk,  R=0.2  at  (.45,  .45, 0.)  Normal  Disk,  R=0.449  at  (.45,  .45, 0.) 


[wo]  a 


[wo]  a 
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electron  source  energy  =  6  MeV 


2.2  ITS-ACCEPT  Electron/Photon  Transport  Simulations  for  the  HEP  Instrument 

A  new  ACCEPT  geometry  input  file  for  the  in-flight  version  of  the  HEP  instrument  was 
created  from  a  complete  set  of  manufacturing  drawings  supplied  by  Amptek,  Inc.  [5].  This 
geometry  description  exactly  mimics  the  geometry  description  written  during  the  first  year  of  this 
effort  for  MCNPX  [6].  The  ACCEPT  geometry  description,  which  contains  the  same  degree  of 
detail  as  the  manufacturing  drawings,  permits  us  to:  (1)  take  advantage  of  the  speed  and 
efficiency  of  the  ACCEPT  code  for  performing  coupled  electron-photon  transport  calculations  in 
complicated  structures;  and  (2)  use  the  ACCEPT  code  to  confirm  the  validity  of  the  MCNPX 
geometry  description  by  comparing  electron  transport  results  obtained  with  the  two  programs. 
Unlike  ACCEPT,  MCNPX  can  be  used  to  perform  transport  calculations  for  protons,  neutrons, 
mesons,  and  other  particle  species.  It  is  therefore  important  to  have  the  ACCEPT  version  of  the 
HEP  geometry  to  use  as  an  independent  verification  of  the  MCNPX  geometry  description. 

Figure  5  shows  a  cut-away  view  of  the  HEP  sensor.  This  illustration  was  drawn  using 
SABRINA  [3J  an  interactive,  three-dimensional  geometry  visualization  and  modeling  program 


Figure  5.  Sabrina  [3]  rendering  of  ITS-ACCEPT  [1]  geometry  model  of  HEP  [5]  Flight  Sensor 
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that  can  be  used  to  construct  and  visualize  geometry  models  for  both  MCNPX  and  ACCEPT. 
Additional  useful  features  of  the  SABRINA  program  are:  automatic  conversion  of  ACCEPT 
models  to  the  MCNPX  format  and  particle  track  ray-tracing. 

The  ACCEPT  input  file  corresponding  to  the  HEP  flight  sensor  depicted  in  Figure  5  is  listed 
in  Appendix  1.  Several  ACCEPT  runs  were  made  to  test  the  robustness  of  the  geometry  file. 
The  purpose  was  to  uncover  “holes”  (errors)  in  the  geometry  specification  that  are  not 
immediately  obvious  from  the  pictures  generated  with  SABRINA.  An  efficient  way  to  determine 
which,  if  any,  cells  are  improperly  defined  in  the  input  file  is  to  run  a  large  number  of  case 
histories  for  several  source  configurations  and  energies.  The  diagnostic  messages  that  appear  in 
the  ACCEPT  output  when  a  particle  has  “lost  its  way”  are  of  limited  value.  Because  geometry 
file  flaws  are  usually  manifested  by  abrupt  program  halts  when  ten  particles  have  been  lost,  we 
have  found  that  the  most  effective  method  for  constructing  highly  detailed  geometry  files  is  to 
build  up  the  model  in  gradual  stages  of  complexity.  Test  runs  of  ACCEPT  were  made  using  this 
gradual  approach  until  the  model  illustrated  in  Figure  5  passed  all  tests  for  robustness.  The  run 
file  consisting  of  318  geometric  bodies  defining  505  material  cells  is  listed  in  Appendix  4.  This 
file  was  used  to  simulate  a  25  MeV  electron  disk  source  normally  incident  on  the  front  face  (z  = 
0  plane)  of  the  instrument. 


2.3  ITS-ACCEPT  Program  Enhancements 

The  ITS-ACCEPT  Monte  Carlo  program  modifications  that  were  made  fall  into  two  categories: 
the  addition  of  new  source  options;  and  the  addition  of  code  that  permits  the  user  to  view  the 
energy  deposition  contributions  of  individual  electron  tracks.  The  primary  motivation  for  the 
source  option  enhancement  was  supplied  by  the  fact  that  the  standard  disk  source  option  in 
ACCEPT  does  not  allow  for  the  specification  of  electron  source  beam  slant  angles  without 
slanting  the  source  plane.  Source  electrons  emanating  from  a  plane  with  off-normal  angles  of 
incidence  could  not  originate  at  equidistant  points  from  the  target.  The  demonstration  of  this  is 
given  in  a  set  of  electron  transport  runs  that  were  made  for  the  aluminum-void-silicon  slab 
geometry  shown  in  Figure  6.  Runs  were  made  for  six  source  disk  slant  angles  (0  =  0, 15, 30, 45, 
60,  75°)  The  electron  source  energy  in  all  cases  was  3.5  MeV.  Because  of  the  manner  in  which 
the  standard  disk  source  option  in  ACCEPT  is  implemented,  it  was  necessary  to  adjust  the 
position  of  the  disk  centra-  for  each  0  value  in  order  to  ensure  that  the  source  disk  not  intersect 
with  the  target  medium.  An  ACCEPT  input  data  file  corresponding  to  the  illustration  of  Figure  6 
with  0  =  45°  is  shown  in  Figure  7.  For  the  case  shown,  the  radius  R  of  the  disk  source  was  set  at 
1.0  cm.  For  the  45°  slant  source  it  was  necessary  to  place  the  coordinates  of  the  disk  center  at 
X£  =  2.5,  Ys  =  2.5,  Zs  =  -0.7071067  to  avoid  having  source  electrons  originate  inside  the  target 
medium.  While  the  ACCEPT  code  does  not  permit  this  source  condition,  it  could  be  modified  to 
allow  sources  originating  in  the  interior  of  a  scattering  medium. 
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Figure  6.  Aluminum  /  void  /  silicon  ACCEPT  problem  geometry  (not  drawn  to  scale)  with  slant 
disk  source  as  described  in  the  input  data  file  shown  in  Figure  7. 


2.3.1  Disk  and  Rectangle  Source  Options 

A  capability  was  added  to  the  ACCEPT  program  to  allow  the  use  of  disk  and  rectangular 
spatially  uniform  distributed  sources  (electrons  or  photons)  with  provision  for  changing  the  slant 
angle  of  the  source  beam  direction  without  slanting  the  source  plane  itself.  These  new  options 
are  now  implemented  in  the  code  by  the  addition  of: 

(1)  a  line  such  as 

*  RECTANGLE - SOURCE  2.05  2.95  2.05  2.95  0.0  0.0" 
to  the  ACCEPT  input  file  for  the  rectangle  source  case.  The  6  numbers  (required)  are  the 
bounding  coordinates  of  the  source  rectangle  (xmin,xmax,ymin,ymax,zmin,zmax); 
and  (2) 

"CIRCLE -SOURCE  2.5  2.5  0.0  3.5  2.5  0.0" 

to  the  ACCEPT  input  file  for  the  disk  source  case.  The  6  (required)  numbers  are  the  X ,  Y ,  Z 
coordinates  of  the  disk  center  and  a  point  on  the  disk  circumference.  The  program  computes  the 
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source  disk  radius  and  checks  internal  consistency  by  comparing  this  value  with  the  value 
entered  on  the  "RADIUS"  input  line.  In  both  the  rectangle  and  circle  source  cases,  if  an  error  in 
the  input  data  violates  the  conditions  for  geometric  validity,  informative  diagnostics  messages 
are  printed  in  the  ACCEPT  output  file,  and  the  run  is  aborted.  One  restriction  in  the  use  of  these 
options  is  that  the  orientation  of  the  source  planes  cannot  be  arbitrarily  chosen.  Their  orientation 
must  be  perpendicular  to  any  one  of  the  three  Cartesian  coordinate  axes.  Since  the  choice  of 
orientation  of  the  source  beam  is  allowed  to  be  arbitrary,  this  restriction,  which  greatly  simplified 
the  re-programming  of  ACCEPT,  does  not  result  in  sacrifice  of  utility. 

Test  runs  were  made  for  both  the  rectangle  and  disk  source  cases.  The  disk  source  results 
were  validated  by  matching  the  old  disk  source  results  for  normal  incidence. 

TITLE 

3.5  MEV  ON  AL/VOID/SI ,  SLANT  DISK  SOURCE  (THETA=45deg)  ZS=- .7071 
**********************  GEOMETRY  *********************** 


GEOMETRY 

*1 

RPP 

0.000 

5.000 

0.000 

5.000 

0.000 

0.635 

*2 

RPP 

0.000 

5.000 

0.000 

5.000 

0.635 

0.792 

*3 

RPP 

2.050 

2.950 

2.050 

2.950 

0.792 

0.842 

*4 

SPH 

*5 

SPH 

END 

♦ZONES 

2.500 

2.5 

2.500 

2.5 

0.421 

0.421 

4.243 

10.0 

Z01  +1 
Z02  +2 
Z03  +3 

Z04  +4  -1  -2  -3 

*  ESCAPE  ZONE  IS  A  VOID  SPHERE  OF  RADIUS  10  CM  ENCLOSING  THE  SLAB 
Z05  +5  -1  -2  -3  -4 

END 

♦MATERIAL 

1 

0 

2 

0 

0 

***********************  SOURCE  ******************** 

ELECTRONS 
ENERGY  3 . 5 

POSITION  2.5  2.5  -0.7071067 

RADIUS  1.0 
DIRECTION  45.0  0.0 

Figure  7.  ACCEPT  Input  data  file  for  3.5  MeV  45°  slant  disk  source  incident  on  aluminum  / 
void  /  silicon  configuration  shown  in  Figure  6. 

23.2  Individual  Electron  Track  Option 

The  second  modification  to  ACCEPT  permits  the  user  to  view  the  energy  deposition 
contributions  of  individual  case  histories  (electron  tracks)  in  as  many  as  10  problem  geometry 
cells.  To  implement  this  option,  a  line  of  the  following  form 


"INDIVIDUAL-HISTS  92  145  93  146" 

is  added  to  the  ACCEPT  input  file.  The  four  numbers  shown  in  the  above  example  are  the  cell 
numbers  corresponding  to  the  electrically  active  parts  (92,  145)  of  the  CEASE  front  and  back 
silicon  detectors,  respectively,  and  their  corresponding  electrically  inactive  parts  (93,  146).  A 
supplementary  output  file  (EDSHOW.TXT)  is  produced  by  this  version  of  ACCEPT  and 
consists  of:  (a)  tables  (5  columns),  for  each  cell,  of  (1)  the  case  history  number,  energy 
deposition  contributions  [MeV]  by  the  (2)  primary  electron,  (3)  knock-on  electrons,  (4) 
bremsstrahlung  produced  secondary  electrons  [see  Figure  8],  and  (5)  total  energy  deposition;  and 
(b)  a  summary  table  showing  the  total  energy  deposition,  for  each  history,  in  each  cell  (for 
example,  4  columns  corresponding  to  cells  92,  145,  93,  146)[see  Figure  9],  This  last  summary 
table  allows  for  quick  recognition  of  coincidence  events  occurring  in  the  front  and  back 
detectors. 


ENERGY  DEPOSITION  IN  CELL  NO 

92 

Hist.  no. 

Primary 

Knock-on 

Secondary 

Total 

1 

. 44027E-01 

.00000E+00 

.OOOOOE+OO 

.  44027E-01 

2 

. 52327E-01 

.OOOOOE+OO 

.OOOOOE+OO 

.  52327E-01 

3 

. 77735E-01 

.OOOOOE+OO 

.OOOOOE+OO 

. 77735E-01 

4 

. 11630E+00 

.OOOOOE+OO 

.OOOOOE+OO 

. 11630E+00 

5 

. 53479E-01 

.OOOOOE+OO 

.OOOOOE+OO 

. 53479E-01 

6 

. 61459E-01 

.OOOOOE+OO 

.OOOOOE+OO 

. 61459E-01 

7 

. 10316E+00 

.OOOOOE+OO 

.OOOOOE+OO 

. 10316E+00 

B 

. 53607E-01 

.OOOOOE+OO 

.OOOOOE+OO 

. 53607E-01 

9 

. 49054E-01 

.OOOOOE+OO 

.OOOOOE+OO 

• 

• 

.  49054E-01 

96 

. 44499E-01 

.OOOOOE+OO 

# 

.OOOOOE+OO 

.44499E-01 

97 

. 76406E-01 

.OOOOOE+OO 

.OOOOOE+OO 

. 76406E-01 

98 

. 71468E-01 

.OOOOOE+OO 

.OOOOOE+OO 

.  71468E-01 

99 

. 88710E-01 

.OOOOOE+OO 

.OOOOOE+OO 

.  88710E-01 

100 

. 56262E-01 

.OOOOOE+OO 

.OOOOOE+OO 

. 56262E-01 

ENERGY  DEPOSITION  IN  CELL  NO. 

145 

Hist.  no. 

Primary 

Knock-on 

Secondary 

Total 

1 

. 45224B+00 

.OOOOOE+OO 

.OOOOOE+OO 

.45224E+00 

2 

. 00000E+00 

.OOOOOE+OO 

.OOOOOE+OO 

.OOOOOE+OO 

3 

. 00000E+00 

.OOOOOE+OO 

.OOOOOE+OO 

.OOOOOE+OO 

4 

. 38100E+00 

.OOOOOE+OO 

.OOOOOE+OO 

• 

• 

.  38100E+00 

94 

. OOOOOE+OO 

.OOOOOE+OO 

• 

• 

.OOOOOE+OO 

.OOOOOE+OO 

95 

. OOOOOE+OO 

.OOOOOE+OO 

.OOOOOE+OO 

.OOOOOE+OO 

96 

. 35406E+00 

.OOOOOE+OO 

.OOOOOE+OO 

. 35406E+00 

97 

.00000E+00 

.OOOOOE+OO 

.OOOOOE+OO 

.OOOOOE+OO 

98 

. 18983E+00 

.OOOOOE+OO 

.OOOOOE+OO 

. 18983E+00 

99 

.408096+00 

.OOOOOE+OO 

.OOOOOE+OO 

. 40809E+00 

100 

.00000E+00 

.OOOOOE+OO 

.OOOOOE+OO 

.OOOOOE+OO 

Figure  8.  Portion  of  EDSHOW.TXT  file  produced  by  ACCEPT  when  the 
INDIVIDUAL-HISTS"  option  is  exercised.  The  table  itemizes  contributions  to 
energy  deposition  attributable  to  primary,  knock-on  and  secondary  electrons  for 
every  case  history. 
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TOTAL  ENERGY  DEPOSITION  IN 

CELLS 

92 

145 

93 

146 

Hist.no. 

1 

. 44027E-01 

. 45224E+00 

.00000E+00 

.OOOOOE+OO 

2 

. 52327E-01 

.  OOOOOE+OO 

.00000E+00 

.OOOOOE+OO 

3 

. 77735E- 01 

.  00000E+00 

.00000E+00 

.OOOOOE+OO 

4 

. 11630E+00 

. 38100E+00 

.00000E+00 

.OOOOOE+OO 

5 

. 53479E- 01 

.  44387E+00 

.00000E+00 

.OOOOOE+OO 

6 

. 61459E-01 

.00000E+00 

.OOOOOE+OO 

.OOOOOE+OO 

7 

. 10316E+00 

.00000E+00 

.OOOOOE+OO 

.OOOOOE+OO 

8 

. 53607E- 01 

. 16434E+00 

.OOOOOE+OO 

.OOOOOE+OO 

9 

. 49054E-01 

. 44833E+00 

.OOOOOE+OO 

• 

• 

.OOOOOE+OO 

97 

. 76406E-01 

.OOOOOE+OO 

• 

• 

.OOOOOE+OO 

.OOOOOE+OO 

98 

. 71468E-01 

. 18983E+00 

.OOOOOE+OO 

.OOOOOE+OO 

99 

. 88710E- 01 

.  40809E+00 

.OOOOOE+OO 

.OOOOOE+OO 

100 

. 56262E-01 

.00000E+00 

.OOOOOE+OO 

.OOOOOE+OO 

Figure  9.  Portion  of  EDSHOW.TXT  file  produced  by  ACCEPT  when  the 
"INDIVIDUAL-HISTS"  option  is  exercised.  This  table  lists  total  energy 
deposition  in  all  requested  cells  for  every  case  history. 


Program  listings  of  the  ACCEPT  subroutines  that  were  modified  to  incorporate  the 
"RECTANGLE-SOURCE",  "CIRCLE-SOURCE"  and  "INDIVIDUAL-HISTS"  options  are 
given  in  Appendix  2. 


3.  Proton  Transport  Modeling 

3.1  Energy  Deposition  Calculations  -  CEASE  Telescope 

Energy  deposition  plots  (see  Figure  10)  for  electrons  and  protons  were  supplied  by  AFRL  [6]. 
The  curves  shown  in  Figure  10  represent  calculations  for  the  front  (DFT  -  thickness  =  0.015  cm) 
and  back  (DBT  -  thickness  =  0.05cm)  silicon  wafer  detectors  in  the  CEASE  telescope.  This 
provided  an  opportunity  to  test  the  validity  of  our  CEASE  model  and  the  physical  realism  of 
MCNPX  proton  transport  calculations.  The  CEASE  model  [7]  written  earlier  for  MCNPX  was 
used  in  eight  Monte  Carlo  runs  corresponding  to  proton  source  energies,  4, 4.5, 5, 7.5,  9.5,15, 30, 
100  MeV  with  normally  incident  protons  (disk  sources  covering  the  telescope  aperture).  The 
MCNPX  simulation  results,  EdepDBT  vs.  EdepDFT  for  the  proton  sources,  are  plotted  in  Figure  1 1 . 
They  appear  to  closely  track  the  proton  energy  deposition  curves  of  Figure  10. 
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Edep  in  DBT  (MeV) 


Computed  Energy  Depositions  in  CEASE  Telescope 


Energy  Deposited  in  Front  Detector,  DFT  (keV) 


Figure  10.  Computed  energy  depositions  due  to  protons  and  electrons  in  DBT 
vs.  DFT  for  the  CEASE  telescope[4,6] 


Proton  Energy  Deposition 
MCNPX  simulations 


IE-2  0.1  1  1 E  +  1 

Edep  in  DFT  (MeV) 

Figure  1 1 .  Energy  depositions  due  to  protons  in  DBT  vs.  DFT  for  the  CEASE 
telescope  as  computed  with  the  MCNPX  simulation  program. 
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3.2  Coincidence  Event  Identification  -  CEASE 

A  short  FORTRAN  program,  count.F,  was  written  to  analyze  the  track  file  ("ptrac")  produced 
by  MCNPX  in  order  to  identify  coincidence  events  in  the  DFT  and  DBT  detectors.  This  program 
lists  the  energy  deposition  from  protons  in  each  detector  for  each  proton  track  history  and 
enables  the  investigator  to  recognize  and  evaluate  coincidence  events.  The  program  is  also 
configured  to  record  the  energy  deposition  in  any  cell  of  the  CEASE  simulation  geometiy.  An 
annotated  sample  output  file  displaying  the  accounting  results  for  10000  proton  histories  (100 
MeV  proton  source  in  CEASE  aperture,  normal  incidence)  in  shown  in  Figure  12.  The  cell 
numbers  containing  the  coincidence  events  listed  at  the  end  of  the  output  identify  tracks  of 
interest  that  can  be  re-examined.  The  program  listing  of  count.F  is  given  in  Appendix  3. 


1 

0 . OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0.  OOOOOE+OO 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

2 

0 . OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

3 

0. 00000E+00 

0 

0. OOOOOE+OO 

0 

0 .  OOOOOE+OO 

• 

0 

0. OOOOOE+OO 

0 

0 . OOOOOE+OO 

24 

0 . 47660E-02 

13 

0.47660E-02 

0 

• 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

25 

0 . 14176E+00 

125 

0 . 14176E+00 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

26 

0 . 31609E+00 

246 

0 . 31603E+00 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

1 

0.58880E-04 

27 

0 . 46626E+00 

357 

0 . 46478E+00 

0 

0. OOOOOE+OO 

0 

0.  OOOOOE+OO 

1 

0 . 14821E-02 

28 

0 . 60600E+00 

467 

0 . 60600E+00 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

29 

0 . 73127E+00 

549 

0 . 73111E+00 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

1 

0 . 16188E-03 

30 

0 . 83742E+00 

631 

0 . 83742E+00 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

31 

0 . 96039E+00 

704 

0 . 95784E+00 

0 

0. OOOOOE+OO 

0 

0.  OOOOOE+OO 

2 

0 . 25468E-02 

32 

0 . 10499E+01 

760 

0 . 10499E+01 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

1 

0 . 45840E-04 

33 

0 . 11213E+01 

807 

0 . 11213E+01 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

34 

0 . 12038E+01 

874 

0 . 12038E+01 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

35 

0 . 12848E+01 

906 

0 . 12848E+01 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

1 

0 . 21850E-04 

36 

0 . 13170E+01 

931 

0 . 13170E+01 

0 

0. OOOOOE+OO 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

37 

0 . 15761E-01 

290 

0 . 15761E-01 

0 

0.  OOOOOE+OO 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

38 

0 . 94740E+00 

333 

0 . 94740E+00 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

39 

0 „ 12217E-01 

705 

0 . 12217E-01 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

40 

0.28122E+01 

700 

0 . 28122E+01 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

41 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

42 

0. 00000E+00 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

43 

0 . 17045E+00 

229 

0 . 17045E+00 

0 

0. OOOOOE+OO 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

44 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

45 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0.  OOOOOE+OO 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

46 

0 . 64099E+00 

605 

0 . 64099E+00 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

47 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

48 

0 . 26440E-02 

0 

0.  OOOOOE+OO 

0 

0. OOOOOE+OO 

1 

0 . 13955E-05 

3 

0 . 26426E-02 

49 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0.  OOOOOE+OO 

0 

0 .  OOOOOE+OO 

0 

0. OOOOOE+OO 

50 

0 . 26963E+01 

198 

0 . 26587E+01 

0 

0. OOOOOE+OO 

6 

0 . 63279E-02 

31 

0 . 31316E-01 

51 

0 . 75840E+00 

228 

0 . 75837E+00 

0 

0. OOOOOE+OO 

• 

1 

0 . 12650E-04 

1 

0.11150E-04 

61 

0 . 94892E+00 

667 

0 . 94866E+00 

0 

• 

0. OOOOOE+OO 

0 

0.  OOOOOE+OO 

2 

0.26012E-03 

62 

0 . 20318E+00 

684 

0.20318E+01 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

0 

0. OOOOOE+OO 

o  nnnr>nt24.nn 

n 

n  nnnnmsjunn 

0 

n  nnnnrns.*.nn 

0 

n  nnnnn^no 

n 

n  nnnnnw^nn 

Figure  12.  Output  file  from  count.F  interpreting  particle  track,  coincidence  event  and  energy 
deposition  data  from  MCNPX-ptrac  file  for  protons,  electrons,  neutrons  and  photons. 
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734 

746 

753 

759 

762 

796 

799 

801 

804 

807 

809 

813 

816 

847 

850 

853 

854 

859 

863 

865 

867 

889 

892 

901 

904 

906 

913 

916 

921 

946 

961 

963 

964 

970 

973 

979 

980 

Figure  12  (cont.).  Output  file  from  count. F  interpreting  particle  track,  coincidence  event  and 
energy  deposition  data  from  MCNPX-ptrac  file  for  protons,  electrons,  neutrons  and  photons. 
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3.3  Beam  Source  Subroutine  for  MCNPX 

A  specialized  source  subroutine  that  allows  the  user  to  run  beam  sources  at  arbitrary  positions 
and  arbitrary  orientations  was  written  for  use  with  MCNPX.  MCNPX  makes  allowance  for  user- 
supplied  source  routines  in  addition  to  those  supplied  in  the  program.  This  is  accomplished  by 
omission  of  the  source  descriptor  records  in  the  MCNPX  input  data  file.  When  this  is  done,  the 
programs  searches  for  the  user-supplied  "SUBROUTINE  SOURCE".  In  our  version  the  user 
enters,  as  input  to  screen  prompts,  the  source  position  (x,  y,  z),  source  direction  cosines  (u,  v,  w), 
source  particle  type  (ipt),  source  particle  energy  (MeV),  geometry  surface  number  on  which  or 
cell  number  in  which  the  source  origination  point  is  located.  The  program  listing  for  source.F  is 
given  in  Appendix  4. 


4.  Dome  Dosimeter  Study 

Electron  and  proton  transport  calculations  were  made  for  the  CEASE  DD1  and  DD2 
dosimeters  [4]  and  PASP  Dome  D2  and  D3  dosimeters  [8,9]  using  the  ITS/ACCEPT  and 
MCNPX  simulation  programs.  The  purpose  of  these  calculations  was  to  provide  a  means  for 
determining  the  effects  of  differences  in  shield  geometry  on  dose  measurements  in  the  same 
radiation  environment.  The  data  sets  obtained  with  the  CEASE  and  PASP  dosimeters, 
normalized  to  take  into  account  differences  in  shielding  geometry,  would  then  be  used  to  study 
the  solar  cycle  dependence  of  the  electron  dose  from  the  outer  radiation  belt. 

The  schematic  shown  in  Figure  13  for  the  CEASE  DD1  and  DD2  dosimeter  assemblies  was 
provided  by  AFRL[10].  The  dosimeter  assembly  consists  of  a  flat  rectangular  silicon  diode 
resting  on  an  aluminum  oxide  substrate,  which  in  turn  is  mounted  on  an  aluminum  base.  The 
dosimeter  is  capped  with  an  aluminum  plate. 

4.1  CEASE  Dosimeter  Models  -  ACCEPT  and  MCNPX 

Models  for  the  original  CEASE  DD1  and  DD2  geometries  were  obtained  directly  using  the 
"CIRCLE-SOURCE"  option  as  described  in  Section  2.3.1,  above.  Isotropic  electron  sources 
were  assumed  uniformly  distributed  on  the  disc  surface  as  shown  in  Figure  14.  We  then  wrote 
and  installed  a  new  source  option,  "DOME  SOURCE",  for  ITS/ACCEPT  in  which  the  isotropic, 
inward-directed  electron  source  is  assumed  to  be  uniformly  distributed  on  the  surface  of  a  thin 
void  hemispherical  shell  with  the  same  radius  as  the  disc  shield  plates.  This  source  is  depicted  in 
the  ACCEPT  geometry  schematic  of  Figure  15.  The  ACCEPT  input  file  corresponding  to  the 
geometries  shown  in  Figures  14  and  15  is  listed  in  Appendix  5  for  the  CEASE  DD1  dosimeter. 
Both  the  "CIRCLE-SOURCE"  and  "DOME  SOURCE"  input  data  (see  annotations)  are  shown 
in  the  same  file  listing  to  conserve  space. 
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Figure  13.  CEASE  DD1  and  DD2  dosimeter  assemblies  [10]. 


Figure  14.  CEASE  DD1  and  DD2  dosimeter  geometry  schematic  for  ACCEPT  showing 
plane  isotropic  electron  source;  geometry  zones;  nn  =  material  cells. 
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Figure  15.  CEASE  DD1  and  DD2  dosimeter  geometry  schematic  for  ACCEPT  showing 
hemispherically  shaped  isotropic  electron  source;  CZ^~  geometry  zones;  nn  =  material  cells. 


The  equivalent  simulation  scenarios  were  executed  using  MCNPX.  Figure  16  is  a  surface  and 
cell  schematic  for  the  DD1,  DD2  MCNPX  model  corresponding  to  that  shown  for  ACCEPT  in 
Figure  15.  The  corresponding  MCNPX  input  file  for  DD2  is  given  in  Appendix  6.  For  the  case 
of  the  flat  plate  source,  the  MCNPX-supplied  source  provided  a  cosine-isotropic  source  option 
that  could  be  implemented  using  the  run  input  data  file.  It  was  necessary  to  write  a  source 
subroutine  for  MCNPX  that  allowed  isotropy  in  angle  rather  than  cosine.  It  was  also  necessary  to 
write  new  source  subroutines  for  the  hemispherical  shell  sources.  These  code  modifications 
provided,  along  with  appropriate  geometry  factor  adjustments,  a  tool  for  the  AFRL  researchers  to 
compare  simulated  dosimeter  responses  with  different  source  geometry  assumptions. 
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The  PASP  dome  dosimeters  were  modeled  using  the  "HEMISPHERICAL  DOME  SOURCE" 
option  in  ITS/ACCEPT  and  new  source  routines  for  MCNPX.  The  ACCEPT  geometry 
schematics  and  source  configuration  for  the  PASP  Dome  2  and  Dome  3  dosimeters  are  shown  in 
Figures  17a  and  17b,  respectively.  The  corresponding  geometry  schematics  for  MCNPX  are 
shown  in  Figures  18a  and  18b.  The  computer  code  listings  for  the  "DOME  SOURCE"  option  in 
ACCEPT  and  the  specialized  source  subroutines  for  MCNPX  are  given  in  Appendices  7  and  8, 
respectively. 
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Figure  17a.  "PASP  Dome  2"  dosimeter[8,9]  geometry  Schematic  for  ACCEPT  showing  isotropic 
electron  source  incident  on  surface  of  A1  dome,d^  =  geometry  zones;  nn  =  material  cells. 


Figure  17b.  "PASP  Dome  3"  dosimeter[8,9]  geometry  schematic  for  ACCEPT  showing  isotropic 
electron  source  incident  on  surface  of  A1  dome;  CI^=  geometry  zones;  nn  =  material  cells. 


Figure  18a.  "PASP  Dome  2"  dosimeter  geometry  schematic  for  MCNPX  showing  isotropic 
electron  or  proton  source  incident  on  surface  of  A1  dome;  =  surfaces;  nn  =  material  cells. 


Figure  18b.  "PASP  Dome  3"  dosimeter  geometry  schematic  for  MCNPX  showing  isotropic 
electron  or  proton  source  incident  on  surface  of  A1  dome;CZ^  =  surfaces;  nn  =  material  cells 


In  all  cases,  trial  runs  were  made  with  small  numbers  of  histories  (10000)  to  check  on 
equivalence  of  the  results  obtained  with  both  codes.  While  the  modified  version  of 
ITS/ACCEPT  was  sufficient  to  accomplish  the  immediate  goals  of  modeling  electron  transport, 
the  addition  of  MCNPX  provided:  (1)  a  check  on  the  ITS/ ACCEPT  results;  and  (2)  a  capability 
for  modeling  proton  transport  with  the  same  problem  geometries.  Electron  transport  simulations 
were  run  at  AFRL  using  the  CEASE  and  PASP  dosimeter  models  described  above  for  several 
power  law  electron  energy  spectra  characteristic  of  the  outer  belt  electron  environment.  Results 
are  reported  in  [1 1]. 

5.  Summary 

During  the  period  covered  by  this  report,  the  technical  activity  and  progress  achieved 
consisted  primarily  of:  (1)  modeling  of  electron  transport  and  calculation  of  electron  energy 
deposition  in  silicon  dosimeter  wafers;  (2)  construction  of  a  highly  detailed  ITS-ACCEPT 
computer  model  for  the  HEP  sensor,  in-flight  model;  (3)  design  and  installation  of 
enhancements  such  as  expanded  source  geometry  repertoire,  single  history  tracking,  and 
coincidence  event  recognition  capability,  to  the  ITS-ACCEPT  transport  program;  (4) 
construction  of  geometry  and  electron  and  proton  source  models  for  CEASE  and  PASP 
dosimeter  studies;  (5)  acquisition  and  implementation  of  a  three-dimensional  geometry 
construction  and  visualization  program  that  is  compatible  with  both  the  ITS  and  MCNP  code 
series;  (6)  providing  assistance,  advice,  input  data  files  and  computer  code  enhancements  to 
AFRL  for  implementation  by  AFRL  research  personnel. 

We  anticipate  continuing  this  and  related  research  efforts  by  providing  simulation 
calculations  and  results,  computer  code  enhancements  and  new  geometry  models,  and  by 
performing  in  an  advisory  capacity  to  the  sponsor. 
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Appendix  1 

Annotated  ITS-ACCEPT  Input  Data  File  for  the  HEP  In-Flight  Instrument 

25  MEV  ELECTRON  DISK  SOURCE  -  HEP  FLIGHT  MODEL ,  FRONT  ENTRY,  NORMAL  INCIDENCE 
**********************  GEOMETRY  *********************** 

GEOMETRY 

♦BODIES 

*1 


TRC 

o 

o 

0.0 

0.0 

0.0 

0.00000 

0.25400 

0.6096  0.56239 6 

*2 

RCC 

0.0 

o 

o 

o 

o 

o 

o 

0.00000 

0.25400 

0.80010 

*3 

RCC 

o 

o 

o 

o 

0.0 

0.0 

0.00000 

0.25400 

1.58877 

*4 

RCC 

o 

o 

o 

o 

Q 

O 

o 

o 

0.00000 

0.25400 

2.0955 

*5 

TRC 

o 

o 

o 

o 

0.25400 

o 

o 

0.00000 

0.25400 

0.56239 6  0.5151928 

*6 

RCC 

o 

o 

o 

o 

0.25400 

o 

o 

0.00000 

0.25400 

0.80010 

*7 

RCC 

o 

o 

o 

o 

0.25400 

o 

o 

0.00000 

0.25400 

2.0955 

*8 

TRC 

o 

o 

o 

o 

0.50800 

o 

o 

0.00000 

0.9271 

0.5151928  0.3429 

*9 

RCC 

0.0 

o 

o 

0.50800 

0.0 

0.00000 

0.9271 

0.80010 

*10 

RCC 

0.0 

o 

o 

0.50800 

0.0 

0.0 

0.9271 

1.58877 

*11 

RCC 

o 

o 

o 

o 

0.50800 

o 

o 

0.00000 

0.9271 

2.0955 

*12 

RCC 

0.0 

0.0 

1.43510 

0.0 

0.00000 

0.11690 

1.58877 

*13 

RCC 

o 

o 

o 

o 

1.43510 

o 

o 

0.00000 

0.11690 

2.0955 

*14 

RCC 

o 

o 

o 

o 

1.55200 

o 

o 

0.00000 

0.05070 

1.58877 

*15 

RCC 

o 

o 

o 

o 

1.55200 

o 

o 

0.00000 

0.05070 

2.0955 

*16 

RCC 

0.0 

o 

o 

1.60270 

0.0 

0.00000 

0.01274 

0.47625 

*17 

RCC 

0.0 

0.0 

1.60270 

o 

o 

0.00000 

0.01274 

1.43510 

*18 

RCC 

o 

o 

o 

o 

1.60270 

o 

o 

0.00000 

0.01274 

1.58877 

*19 

RCC 

o 

o 

o 

o 

1.60270 

o 

o 

0.00000 

0.01274 

2.0955 

*20 

TRC 

o 

o 

0.0 

1.61544 

0.0 

o 

o 

0.08128 

0.5  0.38000 

*21 

RCC 

0.0 

0.0 

1.61544 

0.0 

o 

o 

0.08128 

0.50000 

*22 

RCC 

o 

o 

o 

o 

1.61544 

o 

o 

o 

o 

0.08128 

0.69850 

*23 

RCC 

0.0 

o 

o 

1.61544 

0.0 

0.0 

0.08128 

1.43510 

*24 

RCC 

0.0 

0.0 

1.61544 

o 

o 

0.0 

0.08128 

1.58877 

*25 

RCC 

o 

o 

o 

o 

1.61544 

o 

o 

o 

o 

0.08128 

2.0955 

*26 

TRC 

o 

o 

o 

o 

1.69672 

o 

o 

o 

o 

0.06668 

0.38000  0.28209 

*27 

RCC 

o 

o 

0.0 

1.69672 

o 

o 

0.00000 

0.06668 

0.5 

*28 

RCC 

0.0 

o 

o 

1.69672 

o 

o 

0.00000 

0.06668 

0.6350 

*29 

RCC 

o 

o 

o 

o 

1.69672 

o 

o 

0.00000 

0.06668 

0.6985 

*30 

RCC 

0.0 

0.0 

1.69672 

o 

o 

0.00000 

0.06668 

1.43510 

*31 

RCC 

o 

o 

0.0 

1.69672 

0.0 

0.00000 

0.06668 

1.58877 
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*32 


RCC 

♦33 

0.0 

0.0 

1.69672 

0.0 

0.00000 

0.06668 

2.0955 

RCC 

♦34 

0.0 

0.0 

1.76340 

o 

o 

0,00000 

0.02600 

0.28209 

RCC 

*35 

0.0 

0.0 

1.76340 

0.0 

0.00000 

0.02600 

0.30000 

RCC 

*36 

0.0 

0.0 

1.76340 

0.0 

0.00000 

0.02600 

0.50000 

RCC 

*37 

0.0 

0.0 

1.76340 

0.0 

0.00000 

0.02600 

0.63500 

RCC 

*38 

o 

o 

o 

o 

1.76340 

o 

o 

0.00000 

0.02600 

0.69850 

RCC 

*39 

0.0 

0.0 

1.76340 

0.0 

0.00000 

0.02600 

1.43510 

RCC 

*40 

0.0 

0.0 

1.76340 

0.0 

0.00000 

0.02600 

1.58877 

RCC 

*41 

o 

o 

o 

o 

1.76340 

o 

o 

0.00000 

0.02600 

2.09550 

RCC 

*42 

0.0 

0.0 

1.78940 

o 

o 

0.00000 

0.00801 

0.28209 

RCC 

*43 

0.0 

0.0 

1.78940 

0.0 

0.00000 

0.00801 

0.48200 

RCC 

*44 

o 

o 

o 

o 

1.78940 

0.0 

0.00000 

0.00801 

0.50000 

RCC 

*45 

o 

o 

o 

o 

1.78940 

o 

o 

0.00000 

0.00801 

0.63500 

RCC 

*46 

0.0 

0.0 

1.78940 

o 

o 

0.00000 

0.00801 

0.69850 

RCC 

*47 

o 

o 

0.0 

1.78940 

0.0 

0.00000 

0.00801 

1.43510 

RCC 

*48 

0.0 

0.0 

1.78940 

0.0 

0.00000 

0.00801 

1.58877 

RCC 

*49  * 

0.0 

0.0 

1.78940 

o 

o 

0.00000 

0.00801 

2.09550 

RCC 

*50 

0.0 

0.0 

1.79741 

0.0 

0.0 

0.03400 

0.48200 

RCC 

*51 

0.0 

0.0 

1.79741 

0.0 

0.0 

0.03400 

0.50000 

RCC 

*52 

0.0 

0.0 

1.79741 

0.0 

0.0 

0.03400 

0.69850 

RCC 

*53 

o 

Q 

o 

o 

1.79741 

o 

o 

o 

o 

0.03400 

1.43510 

RCC 

*54 

0.0 

0.0 

1.79741 

0.0 

0.0 

0.03400 

1.58877 

RCC 

*55 

0.0 

0.0 

1.79741 

0.0 

0.0 

0.03400 

2.09550 

RCC 

*56 

o 

o 

0.0 

1.83141 

o 

o 

o 

o 

0.00801 

0.48200 

RCC 

*57 

0.0 

0.0 

1.83141 

o 

o 

o 

o 

0.00801 

0.50000 

RCC 

*58 

0.0 

0.0 

1.83141 

0.0 

0.0 

0.00801 

0.69850 

RCC 

*59 

0.0 

0.0 

1.83141 

0.0 

0.0 

0.00801 

1.43510 

RCC 

*60 

0.0 

o 

o 

1.83141 

o 

o 

o 

o 

0.00801 

1.58877 

RCC 

*61 

0.0 

0.0 

1.83141 

0.0 

0.0 

0.00801 

2.09550 

RCC 

*62 

0.0 

o 

o 

1.83942 

0.0 

0.0 

0.14432 

0.50000 

RCC 

*63 

0.0 

o 

o 

1.83942 

o 

o 

0.0 

0.14432 

0.69850 

RCC 

*64 

0.0 

0.0 

1.83942 

o 

o 

o 

o 

0.14432 

1.43510 

RCC 

*65 

0.0 

0.0 

1.83942 

0.0 

0.0 

0.14432 

1.58877 

RCC 

*66 

0.0 

0.0 

1.83942 

0.0 

0.0 

0.14432 

2.09550 

RCC 

*67 

0.0 

0.0 

1.98374 

o 

o 

0.0 

0.01270 

0.47625 

26 


RCC 

0.0 

o 

o 

1.98374 

o 

o 

o 

o 

0.01270  1.43510 

*68 

RCC 

0.0 

0.0 

1.98374 

0.0 

0.0 

0.01270  1.58877 

*69 

RCC 

o 

o 

0.0 

1.98374 

0.0 

0.0 

0.01270  2.09550 

*70 

RCC 

o 

o 

o 

o 

1.99644 

o 

o 

o 

o 

0.03810  1.58877 

*71 

RCC 

o 

o 

o 

o 

1.99644 

o 

o 

o 

o 

0.03810  2.09550 

*  72 

RCC 

.0 

.0 

2.03454 

.0 

.0 

.0507000 

1.5887700 

*  73 

RCC 

.0 

.0 

2.03454 

.0 

.0 

.0507000 

2.0955000 

*  74 

RCC 

.0 

.0 

2.08524 

.0 

.0 

.0127400 

.4762500 

*  75 

RCC 

.0 

.0 

2.08524 

.  0 

.0 

.0127400 

1.4351000 

*  76 

RCC 

.0 

.0 

2.08524 

.0 

.0 

.0127400 

1.5887700 

*  77 

RCC 

.0 

.0 

2.08524 

.0 

.0 

.0127400 

2.0955000 

*  78 

TRC 

.0 

.0 

2.09798 

.0 

.0 

.0812800 

.5000000 

*  79 

RCC 

.0 

.0 

2.09798 

.0 

.0 

.0812800 

.5000000 

*  80 
RCC 

.0 

.0 

2.09798 

.0 

.0 

.0812800 

.6985000 

*  81 

RCC 

.0 

.0 

2.09798 

.0 

.0 

.0812800 

1.4351000 

*  82 

RCC 

.0 

.0 

2.09798 

.0 

.0 

.0812800 

1.5887700 

*  83 

RCC 

.0 

.0 

2.09798 

.0 

.0 

.0812800 

2.0955000 

*  84 

TRC 

.0 

.0 

2.17926 

.0 

.0 

.0666800 

.3800000 

*  85 

RCC 

.0 

.0 

2.17926 

.0 

.0 

.0666800 

.5000000 

*  86 

RCC 

.0 

.0 

2.17926 

.0 

.0 

.0666800 

.6350000 

*  87 
RCC 

.0 

.0 

2.17926 

.0 

.0 

.0666800 

.6985000 

*  88 
RCC 

.0 

.0 

2.17926 

.0 

.0 

.0666800 

1.4351000 

*  89 
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1.456353 

1.58877  -.635  .635 

6.23294 

7.73938 

*283 

RPP 

1.584653 

1.58877  -.1143  .1143 

0.5080 

8.88018 

*28 

RPP 

1.58877 

1.8415  -.1143  .1143 

0.5080 

8.88018 

*285 

RCC 

.0 

.0  10.16  .0  .0 

0.3175 

2.921 

*286 

RPP 

-2.794 

4.064  -3.9624  3.9624 

10.16 

10.4775 

*287 

RPP 

-2.921 

-2.667  -1.191365  1.191365 

10.16 

10.4775 

*288 

RPP 

-2.159 

4.064  -3.9624  3.9624 

9.906 

10.16 

*289 

RPP 

-2.159 

4.064  -3.9624  3.9624 

0.0 

0.254 

*290 

RPP 

4.064 

4.318  -3.9624  3.9624 

0.0 

10.16 

*291 

RPP 

-2.794  - 

2.159  -3.9624  3.9624 

0.0 

10.16 

*292 

RPP 

-2.159 

4.064  -3.7084  3.9624 

0.254 

9.906 

*293 

RPP 

-2.159 

4.064  -3.9624  -3.7084 

0.254 

9.906 

*294 

RPP 

-2.159 

4.064  -3.7084  3.70840 

0.254 

9.906 

*295 

RCC 

0. 

0.  9.906  0. 

0. 

0.254 

*296 

RPP 

4.318 

5.318  -3.9624  3.9624 

0.0 

10.4775 

*297 

RPP 

-3.794 

-2.794  -3.9624  3.9624 

0.0  10.4775 

*298 

RPP 

-3.794 

5.318  -3.9624  3.9624  - 

■1.0 

0.0 

*299 

RPP 

-3.794 

5.318  -3.9624  3.9624 

10.4775 

11.4775 

*300 

RPP 

-3.794 

5.318  -4.9624  -3.9624 

-1.0 

11.4775 

*301 

RPP 

-3.794 

5.318  3.9624  4.9624 

-1.0 

11.4775 

*302 

RPP 

-1.524 

-0.016  3.7084  3.9624 

1.508125 

8.611575 

*303 

RPP 

-1.5748 

-0.9398  -3.9624  -3.7084 

3.889375 

6.270625 

*304 

RCC 

1.8415 

0.0  1.6764 

0.260 

0.  0.  0.08 

*305 

RCC 

1.8415 

0.0  1.6764 

0.260 

0.  0.  0.08 

*306 

RCC 

1.8415 

0.0  2.21488 

0.260 

0.  0.  0.08 

*307 

RCC 

1.8415 

0.0  2.46888 

0.260 

0.  0.  0.08 

*308 

RCC 

1.8415 

0.0  3.01752 

0.260 

0.  0.  0.08 

*309 

RCC 

1.8415 

0.0  3.27152 

0.260 

0.  0.  0.08 

*310 

RCC 

1.8415 

0.0  4.21986 

0.260 

0.  0.  0.08 

*311 

RCC 

1.8415 

0.0  4.46786 

0.260 

0.  0.  0.08 

*312 

RCC 

1.8415 

0.0  5.88010 

0.260 

0.  0.  0.08 

*313 

RCC 

1.8415 

0.0  6.13410 

0.260 

0.  0.  0.08 

*314 

RCC 

1.8415 

0.0  7.01294 

0.260 

0.  0.  0.08 

*315 

RCC 

1.8415 

0.0  7.26694 

0.260 

0.  0.  0.08 

2.0955 
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*316 


RCC 

*317 

1.8415 

o 

o 

8.54456 

0.260 

0. 

0. 

o 

o 

00 

RCC 

*318 

1.8415 

0.0 

8.79956 

0.260 

0. 

0. 

0.08 

SPH 

0.0 

o 

o 

5.0 

15.0 

END 
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♦ZONES 

♦collimator  aperture 
Z01  +1 

♦Tungsten  P17 
Z02  +2  -1 
♦Tungsten  P17 
Z03  +3  -1  -2 
♦Void 

Z04  +4  -1  -2  -3 

*  collimator  aperture 
Z05  +5 

♦Tungsten  P17 
Z06  +6  -5 
♦Copper  PI 6 
Z07  +7  -6  -5 

*  collimator  aperture 
Z08  +8 

♦Tungsten  P17 
Z09  +9  -8 
♦Copper  PI 6 

Z10  +10  -8  -9  -283 
♦Copper  case  cylinder 

Zll  +11  -10  -9  -8  -283  -284 
♦Copper  P16 
Z12  +12  -283 

♦Copper  case  cylinder 
Z13  +13  -12  -283  -284 
♦Plastic  Kel-F  P4 
Z14  +14  -283 

♦Copper  case  cylinder 
Z15  +15  -14  -283  -284 

+ 

*D1  Assembly  starts  here 

+ 

♦Void  P9 
Z16  +16 

♦Phosphor  Bronze  P9 
Z17  +17  -16 
♦Plastic  Kel-F  P4 
Z18  +18  -17  -16  -283 

♦Copper  case  cylinder 

Z19  +19  -18  -17  -16  -283  -284 
♦Void 
Z20  +20 

♦PCB  Ring  mount 
Z21  +21  -20 
Z22  +22  -21  -20 
♦Plastic  Kel-F  P8 
Z23  +23  -22  -21  -20 
♦Plastic  Kel-F  P4 

Z24  +24  -23  -22  -21  -20  -283 
♦Copper  case  cylinder 

Z25  +25  -24  -23  -22  -21  -20  -283  -284 
♦void 
Z26  +26 

♦PCB  Ring  mount 
Z27  +27  -26 
Z28  +28  -27  -26 
Z29  +29  -28  -27  -26 


♦Plastic  Kel-F  P8 


Two-column  format  used  on  this 
and  the  following  five  pages  to 
conserve  space.  Actual  file 
format  is  single-column. 


Z30  +30  -29  -28  -27  -26 
•Plastic  Kel-F  P4 

Z31  +31  -30  -29  -28  -27  -26  -283 
♦Copper  case  cylinder 

Z32  +32  -31  -30  -29  -28  -27  -26  -283  -284 
♦void 
Z33  +33 

♦Rubber  wafer  mount 
Z34  +34  -33 
♦void 

Z35  +35  -34  -33 
♦PCB  Ring  mount 

Z36  +36  -35  -34  -33 
Z37  +37  -36  -35  -34  -33 
♦Plastic  Kel-F  P8 

Z38  +38  -37  -36  -35  -34  -33 

+ 

♦Plastic  Kel-F  P4 

Z39  +39  -38  -37  -36  -35  -34  -33  -283 
♦Copper  case  cylinder 

Z40  +40  -39  -38  -37  -36  -35  -34  -33  -283 
284 

♦Aluminum  coating  on  Si  wafer 
Z41  +41 
♦Oxide  ring 
Z42  +42  -41 
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*void 

Z43  +43  -42  -41 
♦PCB  Ring  mount 

Z44  +44  -43  -42  -41 
Z45  +45  -44  -43  -42  -41 
♦Plastic  Kel-F  P8 

Z46  +46  -45  -44  -43  -42  -41 
♦Plastic  Kel-F  P4 

Z47  +47  -46  -45  -44  -43  -42  -41  -283 
♦Copper  case  cylinder 

Z48  +48  -47  -46  -45  -44  -43  -42  -41  -283  -284 

♦  Silicon  wafer 
Z49  +49 

♦  void 
Z50  +50  -49 

♦PCB  Ring  mount 
Z51  +51  -50  -49 
♦Plastic  Kel-F  P8 
Z52  +52  -51  -50  -49 
♦Plastic  Kel-F  P4 

Z53  +53  -52  -51  -50  -49  -283 
♦Copper  case  cylinder 

Z54  +54  -53  -52  -51  -50  -49  -283  -284 

♦Aluminum  coating  on  Si  wafer 
Z55  +55 
♦void 

Z56  +56  -55 
♦PCB  Ring  mount 
Z57  +57  -56  -55 
♦Plastic  Kel-F  P8 
Z58  +58  -57  -56  -55 
♦Plastic  Kel-F  P4 

Z59  +59  -58  -57  -56  -55  -283 
♦Copper  case  cylinder 

Z60  +60  -59  -58  -57  -56  -55  -283  -284 

♦void 
Z61  +61 

♦PCB  Ring  mount 
Z62  +62  -61 
♦Plastic  Kel-F  P8 
Z63  +63  -62  -61 
♦Plastic  Kel-F  P4 

Z64  +64  -63  -62  -61  -283 
♦Copper  case  cylinder 

Z65  +65  -64  -63  -62  -61  -283  -284 
♦void 
Z 66  +66 

♦ 

♦End  of  D1  Assembly 
* 

♦Phosphor  Bronze  P9 
Z67  +67  -66 
♦Plastic  Kel-F  P4 
Z68  +68  -67  -66  -283 
♦Copper  case  cylinder 

Z69  +69  -68  -67  -66  -283  -284 

♦  Plastic  Kel-F  P6 
Z70  +70  -283 

♦Copper  case  cylinder 
Z71  +71  -70  -283  -284 

* 

♦Start  of  D2  Assembly 
* 

♦Plastic  Kel-F  P4 
Z72  +72  -283 

♦Copper  case  cylinder 

Z73  +73  -72  -283  -284 

♦Void  P9 
Z74  +74 

♦Phosphor  Bronze  P9 
Z75  +75  -74 


♦Plastic  Kel-F  P4 

Z76  +76  -75  -74  -283 

♦Copper  case  cylinder 

Z77  +77  -76  -75  -74  -283  -284 

♦Void 

Z78  +78 

♦PCB  Ring  mount 
Z79  +79  -78 

Z80  +80  -79  -78 

♦Plastic  Kel-F  P8 


Z81  +81 

-80  -79 

-78 

♦Plastic  Kel 

-F  P4 

Z82  +82 

-81  -80 

-79 

-78 

-283 

♦Copper  case 

cylinder 

Z83  +83 

♦void 

-82  -81 

-80 

-79 

-78 

-283 

Z84  +84 

♦PCB  Ring  mount 

Z85  +85 

-84 

Z86  +86 

-85  -84 

Z87  +87 

-86  -85 

-84 

♦Plastic  Kel 

-F  P8 

Z88  +88 

-87  -86 

-85 

-84 

♦Plastic  Kel 

-F  P4 

Z89  +89 

-88  -87 

-86 

-85 

-84 

-283 

♦Copper  case 

cylinder 

Z90  +90 

-89  -88 

-87 

-86 

-85 

-84 

283  -284 

♦void 

Z91  +91 

♦Rubber  wafer  mount 
Z92  +92  -91 

♦void 

Z93  +93  -92  -91 

♦PCB  Ring  mount 

Z94  +94  -93  -92  -91 

Z95  +95  -94  -93  -92  -91 

♦Plastic  Kel-F  P8 


Z96 

+96  -95  -94 

-93 

-92 

-91 

♦Plastic  Kel-F  P4 

Z97 

+97  -96  -95 

-94 

-93 

-92 

-91 

-283 

♦Copper 

case  cylinder 

Z98 

+98  -97  -96 

-95 

-94 

-93 

-92 

-91 

-283  -284 

♦Aluminum  coating  on  Si  wafer 
Z99  +99 

♦Oxide  ring 

Z100  +100  -99 

♦void 

Z101  +101  -100  -99 

♦PCB  Ring  mount 

Z102  +102  -101  -100  -99 
Z103  +103  -102  -101  -100  -99 
♦Plastic  Kel-F  P8 

Z104  +104  -103  -102  -101  -100  -99 

♦Plastic  Kel-F  P4 

Z105  +105  -104  -103  -102  -101  -100  -99 

283 

♦Copper  case  cylinder 

Z106  +106  -105  -104  -103  -102  -101  -100  - 

99  -283  -284 

*  Silicon  wafer 

Z107  +107 

♦  void 

Z108  +108  -107 

♦PCB  Ring  mount 

Z109  +109  -108  -107 

♦Plastic  Kel-F  P8 

Z110  +110  -109  -108  -107 

♦Plastic  Kel-F  P4 

Zlll  +111  -110  -109  -108  -107  -283 
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♦Copper  case  cylinder 

Z112  +112  -111  -110  -109  -108  -107  -283  - 

284 

♦Aluminum  coating  on  Si  wafer 
Z113  +113 

♦void 

Z114  +114  -113 

♦PCB  Ring  mount 

Z115  +115  -114  -113 

♦Plastic  Kel-F  P8 

Z116  +116  -115  -114  -113 

♦Plastic  Kel-F  P4 

Z117  +117  -116  -115  -114  -113  -283 

♦Copper  case  cylinder 

Z118  +118  -117  -116  -115  -114  -113  -283  -284 

♦void 

Z119  +119 

♦PCB  Ring  mount 
Z120  +120  -119 

♦Plastic  Kel-F  P8 
Z121  +121  -120  -119 

♦Plastic  Kel-F  P4 

Z122  +122  -121  -120  -119  -283 

♦Copper  case  cylinder 

Z123  +123  -122  -121  -120  -119  -283  -284 

♦void 

Z124  +124 

♦Phosphor  Bronze  P9 
Z125  +125  -124 

* 

*  end  of  D2  assembly 


start  of  SI,  S3  assembly 


♦Plastic  Kel-F  P4 
Z126  +126  -125  -124 

♦Copper  case  cylinder 

Z127  +127  -126 

♦  Plastic 
Z128  +128 


-283 


-125  -124  -283  -284 
Kel-F  P6 
-283 

♦Copper  case  cylinder 

Z129  +129  -128  -283  -284 

♦  Plastic  Kel-F  P5 

Z130  +130 

♦  Spectralon  P13,  P14 

Z131  +131  -130 

♦  Plastic  Kel-F  P5 

Z132  +132  -131  -130 

♦  Spectralon  P13,  P14 

Z133  +133  -132  -131  -130  -283 

♦Copper  case  cylinder 

Z134  +134  -133  -132  -131  -130  -283  -284 

♦  GSO  SI  (will  add  pin  diode  later) 

Z135  +135  -269  -270 

♦  Spectralon  P13,  P14 

Z136  +136  -135  -269  -270  -271 

♦Plastic  Scintillator  S3  with  pin  diode  hole 


-274 


Z137  +137 

-136 

-135  -272 

* 

Spectralon 

P13 , 

P14  with  ] 

Z138  +138 

-137 

-136  -135 

♦Copper  case 

cylinder 

Z139  +139 

-138 

-137  -136 

+ 

Plastic 

Kel- 

-F  P5 

Z140  +140 

* 

Spectralon 

P13, 

P14 

Z141  +141 

-140 

* 

Plastic 

Kel- 

-F  P5 

Z142  +142 

-141 

-140 

♦ 

Spectralon 

P13 , 

P14 

Z143  +143 

-142 

-141  -140 

♦Copper  case 

cylinder 

-284 


Z144  +144  -143  -142  -141  -140  -283  -284 

*  Plastic  Kel-F  P5 

Z145  +145  -283 

♦Copper  case  cylinder 

Z146  +146  -145  -283  -284 

* 

♦End  of  S3,  SI  Assembly 

* 

♦Start  D3  Assembly 

+ 

*  Phosphor  Bronze  P9B 
Z147  +147 

♦Plastic  Kel-F  P5 
Z148  +148  -147  -283 

♦Copper  case  cylinder 

Z14 9  +149  -148  -147  -283  -284 

♦Void 

Z150  +150 

♦PCB  annulus 

Z151  +151  -150 

♦Plastic  Kel-F  P7 
Z152  +152  -151  -150 

♦Plastic  Kel-F  P5,P6 

Z153  +153  -152  -151  -150  -283 

♦Copper  case  cylinder 

Z154  +154  -153  -152  -151  -150  -283  -284 

♦Void 

Z155  +155 

♦PCB  annulus 

Z156  +156  -155 

♦Plastic  Kel-F  P7 
Z157  +157  -156  -155 

♦Plastic  Kel-F  P5,P6 

Z158  +158  -157  -156  -155  -283 

♦Copper  case  cylinder 

Z159  +159  -158  -157  -156  -155  -283  -284 

♦Void 

Z160  +160 

♦Rubber  mounting  spacer 
Z161  +161  -160 

♦PMMA 

Z162  +162  -161  -160 

♦Plastic  Kel-F  P7 

Z163  +163  -162  -161  -160 

♦Plastic  Kel-F  P5,P6 

Z164  +164  -163  -162  -161  -160  -283 

♦Copper  case  cylinder 

Z165  +165  -164  -163-  -162  -161  -160  -283  - 

284 

♦Si  wafer  -  electrically  active  part 
Z166  +166 

♦Si  wafer  -  electrically  inactive  part 
Z167  +167  -166 
♦PMMA 

Z168  +168  -167  -166 

♦Plastic  Kel-F  P7 

Z169  +169  -168  -167  -166 

♦Plastic  Kel-F  P5,P6 

Z170  +170  -169  -168  -167  -166  -283 

♦Copper  case  cylinder 

Z171  +171  -170  -169  -168  -167  -166  -283  - 

284 
♦Void 

Z172  +172 

♦Rubber  mounting  spacer 
Z173  +173  -172 

♦Void 

Z174  +174  -173  -172 

♦PMMA 

Z175  +175  -174  -173  -172 
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♦Plastic  Kel-F  P7 

Z176  +176  -175  -174  -173  -172 

♦Plastic  Kel-F  P5,P6 

Z177  +177  -176  -175  -174  -173  -172  -283 

♦Copper  case  cylinder 

Z178  +178  -177  -176  -175  -174  -173  -172  -283 

-284 
♦Void 

Z179  +179 

♦Rubber  mounting  spacer 
Z180  +180  -179 

♦PMMA 

Z181  +181  -180  -179 

♦PMMA 

Z182  +182  -181  -180  -179 

♦Plastic  Kel-F  P7 

Z183  +183  -182  -181  -180  -179 

♦Plastic  Kel-F  P5,P6 

Z184  +184  -183  -182  -181  -180  -179  -283 

♦Copper  case  cylinder 

Z185  +185  -184  -183  -182  -181  -180  -179  -283 

-284 
♦Void 

Z186  +186 

+PCB  annulus 

Z187  +187  -186 

♦PMMA 

Z188  +188  -187  -186 

♦Plastic  Kel-F  P7 

Z189  +189  -188  -187  -186 

♦Plastic  Kel-F  P5,P6 

Z190  +190  -189  -188  -187  -186  -283 

♦Copper  case  cylinder 

Z191  +191  -190  -189  -188  -187  -186  -283  -284 

♦Void 

Z192  +192 

♦PCB  annulus 

Z193  +193  -192 

♦PMMA 

Z194  +194  -193  -192 

♦Plastic  Kel-F  P7 

Z195  +195  -194  -193  -192 

♦Plastic  Kel-F  P5,P6 

Z196  +196  -195  -194  -193  -192  -283 

♦Copper  case  cylinder 

Z197  +197  -196  -195  -194  -193  -192  -283  -284 

♦Phosphor  bronze  P9B 
Z198  +198 

♦Plastic  Kel-F  P5,P6 
Z199  +199  -198  -283 

♦Copper  case  cylinder 

Z200  +200  -199  -198  -283  -284 

♦Plastic  Kel-F  P6 
Z201  +201  -283 

♦Copper  case  cylinder 

Z202  +202  -201  -283  -284 

* 

♦End  D3  Assembly 

* 

♦Begin  S2  Assembly 

* 

♦Plastic  Kel-F  P4 
Z203  +203 

♦Spectralon  P12 

Z204  +204  -203  -283 

♦Copper  case  cylinder 

Z205  +205  -204  -203  -283  -284 

♦GSO  S2 

Z206  +206  -275  -276  -277 

♦Spectralon  P12 


Z207  +207  -206  -275  -276  -277  -278  -279  - 

280  -281  -282  -283 

♦Copper  case  cylinder 

Z208  +208  -207  -206  -283  -284 

♦Plastic  Kel-F  P6 
Z209  +209 

♦Spectralon  P12 

Z210  +210  -209  -283 

♦Copper  case  cylinder 

Z211  +211  -210  -209  -283  -284 

* 

♦end  S2  assembly 
♦begin  D4  assembly 

★ 

♦Plastic  Kel-F  P6 
Z212  +212  -283 

♦Copper  case  cylinder 
Z213  +213  -212  -283 

♦Phosphor  bronze  P9B 
Z214  +214 

♦Plastic  Kel-F  P6 
Z215  +215  -214  -283 

♦Copper  case  cylinder 

Z216  +216  -215  -214  -283  -284 

♦Void 

Z217  +217 

♦PCB  annulus 

Z218  +218  -217 

♦Plastic  Kel-F  P6 

Z219  +219  -218  -217  -283 

♦Copper  case  cylinder 

Z220  +220  -219  -218  -217  -283  -284 

♦Void 

Z221  +221 

♦PCB  annulus 

Z222  +222  -221 

♦Plastic  Kel-F  P6 

Z223  +223  -222  -221  -283 

♦Copper  case  cylinder 

Z224  +224  -223  -222  -221  -283  -284 

♦Void 

Z225  +225 

♦Rubber  mounting  spacer 
Z226  +226  -225 

♦PMMA 

Z227  +227  -226  -225 

♦Plastic  Kel-F  P6 

Z228  +228  -227  -226  -225  -283 

♦Copper  case  cylinder 

Z229  +229  -228  -227  -226  -225  -283  -284 

♦Si  wafer  -  electrically  active  part 
Z230  +230 

♦Si  wafer  -  electrically  inactive  part 
Z231  +231  -230 
♦PMMA 

Z232  +232  -231  -230 

♦Plastic  Kel-F  P6 

Z233  +233  -232  -231  -230  -283 

♦Copper  case  cylinder 

Z234  +234  -233  -232  -231  -230  -283  -284 

♦Void 

Z235  +235 

♦Rubber  mounting  spacer 
Z236  +236  -235 

♦Void 

Z237  +237  -236  -235 

♦PMMA 

Z238  +238  -237  -236  -235 

♦Plastic  Kel-F  P6 

Z239  +239  -238  -237  -236  -235  -283 

♦Copper  case  cylinder 
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Z240  +240  -239  -238  -237  -236  -235  -283  - 

284 
♦Void 

Z241  +241 

♦Rubber  mounting  spacer 
Z242  +242  -241 

♦PCB  annulus 

Z243  +243  -242  -241 

♦PMMA 

Z244  +244  -243  -242  -241 

♦Plastic  Kel-F  P6 

2245  +245  -244  -243  -242  -241  -283 
♦Copper  case  cylinder 

2246  +246  -245  -244  -243  -242  -241  -283  - 

284 

♦Void 

Z247  +247 

♦PCB  annulus 

Z248  +248  -247 

♦PMMA 

Z249  +249  -248  -247 

♦Plastic  Kel-F  P6 

2250  +250  -249  -248  -247  -283 

♦Copper  case  cylinder 

Z251  +251  -250  -249  -248  -247  -283  -284 

♦Void 

Z252  +252 

♦PCB  annulus 

Z253  +253  -252 

♦PMMA 

Z254  +254  -253  -252 

♦Plastic  Kel-F  P6 

Z255  +255  -254  -253  -252  -283 

♦Copper  case  cylinder 

Z256  +256  -255  -254  -253  -252  -283  -284 

♦Phosphor  bronze  P9B 
Z257  +257 

♦PMMA 

Z258  +258  -257  -283 

♦Copper  case  cylinder 

Z259  +259  -258  -257  -283  -284 

♦Plastic  Kel-F  P4 

Z260  +260  -283 

* 

♦end  D4  assembly 
♦Copper  case  cylinder 

Z261  +261  -260  -283  -284 

♦Void 

Z262  +262 

♦Aluminum  pi  8 

Z263  +263  -262  -283 

♦Copper  case  cylinder 

Z264  +264  -263  -262  -283  -284 

♦Copper  base 
Z265  +265 

♦Aluminum  pl8 
Z266  +266  -265 

♦Copper  case  cylinder 
Z267  +267  -266  -265 

♦Copper  base 

Z268  +268  OR  +295 

♦Pin  Diode  Mounted  on  SI  flat 
Z269  +135  +269 

Z270  +136  +269 

♦void  flat  slot  for  pin  diode 
*  carved  out  of  SI 
Z271  +135  +270  -269 

♦carved  out  of  Spectralon 
Z272  +136  +270  -269 

♦carved  out  of  Spectralon 
Z273  +136  +271 


♦Pin  diode  mounted  on  S3  flat 
Z274  +137  +272 

Z275  +138  +272 

♦void  flat  slot  for  pin  diode 
♦  carved  out  of  S3 
Z276  +273  +137  -272 

♦carved  out  of  Spectralon 
Z277  +273  +138  -272 

♦carved  out  of  Spectralon 
Z278  +274  +138 

♦Void  in  front  of  pin  diode  on  S2 
Z279  +206  +276 

♦Pin  diode  on  S2 
Z280  +206  +275 

♦Void  behind  pin  diode  on  S2 
Z281  +206  +277 

♦Void  in  front  of  pin  diode  on  S2 
Z282  +207  +276 

♦Pin  diode  on  S2 
Z283  +207  +275 

♦Void  behind  pin  diode  on  S2 
Z284  +207  +277 

♦Void  in  front  of  pin  diode  on  S2 
Z285  +207  +279 

♦Pin  diode  on  S2 
Z286  +207  +278 

♦Void  behind  pin  diode  on  S2 
Z287  +207  +280 

♦Void  above  Pin  diode  on  S2  cut  out  from 
Spectralon 

Z288  +207  +281 

Z289  +207  +282 

♦Long  void  slot  in  copper  case  to  accommodate 
pin  diode  connections 


Z290 

+  283 

+  11 

Z291 

+283 

+  13 

Z292 

+283 

+  15 

Z2  93 

+283 

+  19 

Z2  94 

+283 

+25 

Z295 

+  283 

+  32 

Z296 

+  283 

+40 

Z297 

+  283 

+  48 

Z298 

+  283 

+  54 

Z299 

+283 

+60 

Z300 

+263 

+  65 

Z301 

+283 

+  69 

Z302 

+283 

+  71 

Z303 

+283 

+  73 

Z304 

+283 

+  77 

Z305 

+283 

+  83 

Z306 

+283 

+  90 

Z307 

+283 

+  98 

Z308 

+283 

+  106 

Z309 

+283 

+112 

Z310 

+283 

+  118 

Z311 

+283 

+123 

Z312 

+283 

+  127 

Z313 

+283 

+  129 

Z314 

+283 

+  134 

Z315 

+283 

+  139 

Z316 

+283 

+  144 

Z317 

+283 

+  146 

Z318 

+283 

+  149 

Z319 

+283 

+  154 

Z320 

+283 

+  159 

Z321 

+283 

+  165 

Z322 

+  283 

+  171 

Z323 

+283 

+  178 

Z324 

+  283 

+  185 

Z325 

+  283 

+  191 

Z326 

+283 

+  197 

38 


Z327 

Z328 

Z329 

Z330 

Z331 

Z332 

Z333 

Z334 

Z335 

Z336 

Z337 

Z338 

Z339 

Z340 

Z341 

Z342 

Z343 

Z344 

Z345 

Z346 

Z347 

Z348 

Z349 

Z350 

Z351 

Z352 

Z353 

Z354 

Z355 

Z356 

Z357 

Z358 

Z359 

Z360 

Z361 

Z362 

Z363 

Z364 

Z365 

Z366 

Z367 

Z368 

Z369 

Z370 

Z371 

Z372 

Z373 

Z374 

Z375 

Z376 

Z377 

Z378 

Z379 

Z380 

Z381 

Z382 

Z383 

Z384 

Z385 

Z386 

Z387 

Z388 

Z389 

Z390 

Z391 

Z392 

Z393 

Z394 

Z395 

Z396 

Z397 

Z398 

Z399 


+283 

+200 

♦Overlap  of  slot  with  material  zones 

+283 

+202 

Z400 

+  12 

+283 

+283 

+205 

Z401 

+  14 

+283 

+283 

+208 

Z402 

+  18 

+283 

+283 

+211 

Z403 

+24 

+283 

+283 

+  213 

Z404 

+31 

+283 

+  283 

+216 

Z405 

+  39 

+283 

+283 

+220 

Z406 

+47 

+283 

+283 

+224 

Z407 

+  53 

+283 

+283 

+229 

Z408 

+  59 

+283 

+283 

+234 

Z409 

+  64 

+283 

+283 

+240 

Z410 

+  68 

+  283 

+  283 

+246 

Z411 

+  70 

+283 

+  283 

+251 

Z412 

+  72 

+283 

+283 

+256 

Z413 

+  76 

+283 

+  283 

+259 

Z414 

+82 

+  283 

+283 

+261 

Z415 

+89 

+283 

+283 

+264 

Z416 

+  97 

+283 

+284 

+  11 

Z417 

+105 

+283 

+284 

+  13 

Z418 

+111 

+283 

+284 

+15 

Z419 

+117 

+283 

+284 

+19 

Z420 

+122 

+283 

+284 

+25 

Z421 

+126 

+283 

+284 

+  32 

Z422 

+128 

+283 

+284 

+40 

Z423 

+  133 

+283 

+284 

+48 

Z424 

+  138 

+283 

+284 

+  54 

Z425 

+  143 

+283 

+284 

+  60 

Z426 

+  145 

+283 

+284 

+65 

Z427 

+  148 

+283 

+  284 

+69 

Z428 

+  153 

+283 

+284 

+  71 

Z429 

+  158 

+283 

+284 

+  73 

Z430 

+  164 

+283 

+284 

+  77 

Z431 

+  170 

+283 

+284 

+83 

Z432 

+  177 

+283 

+284 

+  90 

Z433 

+  184 

+283 

+284 

+  98 

Z434 

+  190 

+283 

+284 

+106 

Z435 

+  196 

+  283 

+284 

+  112 

Z436 

+  199 

+283 

+284 

+  118 

Z437 

+201 

+283 

+284 

+  123 

Z438 

+204 

+283 

+284 

+  127 

Z439 

+207 

+283 

+  284 

+  129 

Z440 

+210 

+283 

+284 

+  134 

Z441 

+212 

+283 

+284 

+  139 

Z442 

+215 

+283 

+284 

+  144 

Z443 

+219 

+283 

+284 

+146 

Z444 

+223 

+283 

+284 

+14  9 

Z445 

+228 

+283 

+284 

+  154 

Z446 

+233 

+283 

+284 

+  159 

Z447 

+239 

+283 

+284 

+  165  . 

Z448 

+245 

+283 

+284 

+  171 

Z449 

+250 

+283 

+284 

+  178 

Z450 

+  255 

+283 

+284 

+185 

Z451 

+258 

+283 

+284 

+  191 

Z452 

+260 

+283 

+284 

+197 

Z453 

+263 

+283 

+  284 

+200 

Z454 

+  10 

+283 

+284 

+202 

♦Stainless  Bulkhead 

+284 

+205 

Z455 

+285 

+284 

+208 

♦VOID  REGION 

SURROUNDING  bulkhead 

+284 

+211 

Z456 

+286 

OR  +287  -285 

+284 

+213 

♦Aluminum  case  back  plate  perp.  to  z 

+284 

+216 

Z457 

+288 

-295 

+284 

+220 

♦Aluminum  case  front  plate  perp.  to  : 

+284 

+224 

Z458 

+  289 

-4 

+284 

+229 

♦Aluminum  case  top  plate  perp.  to  x 

+284 

+234 

Z459 

+290 

+  284 

+240 

♦Aluminum  case  bottom  plate  perp.  to 

+284 

+246 

Z460 

+291 

+284 

+251 

♦Aluminum  case  upper  side  plate  perp 

+284 

+256 

Z461 

+292 

-302 

+284 

+259 

♦Aluminum  case  lower  side  plate  perp 

+  284 

+261 

Z462 

+293 

-303 

+  284 

+264 

' 
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♦Void  cavity  inside  A1  case 
2463  +294  -7  -11  -13  -14  -15 

-19  -25  -32  -40  -48  -54 

-60  -65  -69  -71  -73  -77  -83  -90  -97  -98 

-106  -112  -118  -123  -127  -128  -129  -134  -139  -144  -145 

-146  -149  -154  -159  -165 

-171  -178  -185 

-191  -192  -193  -194  -195 

-196  -197  -198  -199  -200  -201  -202  -203  -204  -205 

-206  -207  -208  -209  -210  -211  -212  -213  -214  -215 

-216  -217  -218  -219  -220  -221  -222  -223  -224  -225 

-226  -227  -228  -229  -230  -231  -232  -233  -234  -235 

-236  -237  -238  -239  -240  -241  -242  -243  -244  -245 

-246  -247  -248  -249  -250  -251  -252  -253  -254  -255 

-256  -257  -258  -259  -260  -261  -262  -263  -264  -265 

-266  -267  -268 


♦Void  region  (rectangular)  surrounding  case 
2464  +296 

Z465  +297 

2466  +298 

Z467  +299 

2468  +300 

2469  +301 

♦Large  connector  hole  in  upper  y  plate 

2470  +302 

♦Small  conector  hole  in  lower  y  plate 

2471  +303 
♦Pinhole  #1 

Z472  +304  +15 
Z473  +304  +19 
Z474  +304  +25 

2475  +304  +32 
♦Pinhole  #2 

2476  +305  +65 

2477  +305  +69 
♦Pinhole  #3 

Z478  +306  +83 
Z479  +306  +90 
2480  +306  +98 
Z481  +306  +106 

2482  +306  +112 
♦Pinhole  #4 

2483  +307  +123 

2484  +307  +127 
♦Pinhole  #5 

Z485  +308  +139 
♦Pinhole  #6 

Z486  +309  +139 
♦Pinhole  #7 

Z487  +310  +139 
♦Pinhole  #8 

Z488  +311  +139 
♦Pinhole  #9 

2489  +312  +165 

2490  +312  +171 
Z491  +312  +178 
Z492  +312  +185 

♦Pinhole  #10 
Z493  +313  +197 
Z494  +313  +200 
Z495  +313  +202 
Z496  +313  +205 
♦Pinhole  #11 
2497  +314  +208 
♦Pinhole  #12 
Z498  +315  +208 
♦Pinhole  #13 
2499  +316  +229 
Z500  +316  +234 


2501  +316  +240 

2502  +316  +246 
♦Pinhole  #14 

2503  +317  +256 

2504  +317  +261 
Z505  +317  +264 

♦Escape  Sphere 
Z506  +318 

-296  -297  -298  -299  -300  -301 

END 


Eight-column  format  on  the  following 
two  pages  used  to  conserve  space. 
Actual  file  format  is  single  column. 
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♦MATER I 

0 

*  71 

9 

AL 

*  36 

9 

*107 

*  1 

2 

*  72 

8 

0 

*  37 

13 

*108 

*  2 

2 

♦  73 

0 

3 

*  38 

9 

*109 

*  3 

13 

*  74 

2 

3 

*  39 

0 

*110 

*  4 

13 

*  75 

13 

0 

*  40 

1 

♦111 

♦  5 

9 

♦  76 

13 

0 

*  41 

13 

*112 

*  6 

2 

*  77 

9 

3 

*  42 

9 

*113 

♦  7 

11 

*  78 

2 

9 

*  43 

0 

*114 

*  8 

0 

*  79 

0 

0 

*  44 

2 

*115 

*  9 

2 

*  80 

2 

3 

*  45 

2 

*116 

*  10 

2 

*  81 

13 

9 

*  46 

13 

*117 

*  11 

13 

*  82 

13 

9 

*  47 

13 

*118 

♦  12 

13 

*  83 

9 

9 

*  48 

9 

*119 

♦  13 

9 

*  84 

0 

9 

*  49 

0 

*120 

*  14 

8 

*  85 

2 

13 

*  50 

2 

*121 

*  15 

0 

*  86 

13 

9 

♦  51 

2 

*122 

*  16 

2 

*  87 

13 

0 

*  52 

2 

*123 

♦  17 

13 

*  88 

9 

1 

*  53 

13 

*124 

*  18 

13 

*  89 

0 

13 

*  54 

13 

*125 

♦  19 

9 

*  90 

1 

9 

*  55 

9 

*126 

♦  20 

2 

*  91 

13 

0 

♦  56 

0 

*127 

*  21 

0 

*  92 

9 

2 

*  57 

6 

*128 

*  22 

2 

*  93 

13 

2 

*  58 

0 

*129 

*  23 

13 

♦  94 

9 

13 

*  59 

2 

*130 

*  24 

13 

♦  95 

13 

13 

♦  60 

2 

*131 

♦  25 

9 

*  96 

12 

9 

*  61 

13 

*132 

*  26 

0 

♦  97 

13 

0 

*  62 

13 

*133 

*  27 

2 

*  98 

12 

2 

♦  63 

9 

*134 

*  28 

13 

*  99 

9 

2 

*  64 

2 

*135 

*  29 

13 

♦100 

4 

2 

*  65 

11 

*136 

♦  30 

9 

♦101 

12 

13 

♦  66 

0 

*137 

♦  31 

0 

*102 

10 

13 

*  67 

2 

*138 

*  32 

1 

♦103 

12 

9 

*  68 

2 

*139 

*  33 

13 

♦104 

9 

0 

*  69 

13 

*140 

*  34 

9 

*105 

13 

6 

*  70 

13 

*141 

*  35 

13 

*106 

12 

*142 

13 

*213 

2 

13 

*178 

9 

*249 

*143 

9 

*214 

7 

12 

*179 

1 

*250 

*144 

0 

*215 

13 

9 

*180 

13 

*251 

*145 

6 

*216 

9 

13 

*181 

9 

*252 

*146 

7 

*217 

0 

9 

*182 

0 

*253 

*147 

7 

*218 

2 

1 

*183 

2 

*254 

*148 

13 

*219 

7 

13 

*184 

13 

*255 

*149 

13 

*220 

13 

9 

*185 

9 

*256 

*150 

9 

*221 

9 

0 

*186 

0 

*257 

*151 

0 

*222 

1 

2 

*187 

2 

*258 

*152 

2 

*223 

7 

13 

*188 

13 

*259 

*153 

7 

*224 

9 

13 

*189 

9 

*260 

*154 

13 

*225 

13 

9 

*190 

0 

*261 

*155 

13 

*226 

9 

0 

*191 

6 

*262 

*156 

9 

*227 

0 

2 

*192 

7 

*263 

*157 

0 

*228 

2 

13 

*193 

13 

*264 

*158 

2 

*229 

9 

13 

*194 

9 

*265 

*159 

7 

*230 

9 

9 

*195 

8 

*266 

*160 

13 

*231 

2 

0 

*196 

8 

*267 

*161 

13 

*232 

9 

6 

*197 

7 

*268 

*162 

9 

*233 

9 

7 

*198 

13 

*269 

*163 

1 

*234 

8 

13 

*199 

9 

*270 

*164 

13 

*235 

8 

13 

*200 

0 

*271 

*165 

9 

*236 

0 

9 

*201 

6 

*272 

*166 

13 

*237 

0 

8 

*202 

0 

*273 

*167 

9 

*238 

0 

8 

*203 

7 

*274 

*168 

13 

*239 

8 

7 

*204 

13 

*275 

*169 

12 

*240 

6 

13 

*205 

9 

*276 

*170 

9 

*241 

0 

13 

*206 

0 

*277 

*171 

10 

*242 

0 

9 

*207 

6 

*278 

*172 

12 

*243 

0 

0 

*208 

2 

*279 

*173 

9 

*244 

0 

6 

*209 

7 

*280 

*174 

13 

*245 

8 

0 

*210 

13 

*281 

*175 

12 

*246 

0 

7 

*211 

9 

*282 

*176 

9 

*247 

0 

13 

*212 

0 

*283 

*177 

13 

*248 

8 

41 


*284 

0 

*285 

0 

*286 

8 

*287 

0 

*288 

0 

*289 

0 

*290 

0 

*291 

0 

*292 

0 

*293 

0 

♦294 

0 

*295 

0 

*296 

0 

*297 

0 

*298 

0 

*299 

0 

*300 

0 

*301 

0 

*302 

0 

*303 

0 

*304 

0 

*305 

0 

*306 

0 

*307 

0 

*308 

0 

*309 

0 

*310 

0 

*311 

0 

*312 

0 

*313 

0 

*314 

0 

*315 

0 

*316 

0 

*317 

0 

*318 

0 

*319 


0 

*355 

0 

*320 

0 

*391 

0 

*356 

0 

*321 

0 

*392 

0 

*357 

0 

*322 

0 

*393 

0 

*358 

0 

*323 

0 

*394 

0 

*359 

0 

*324 

0 

*395 

0 

*360 

0 

*325 

0 

♦396 

0 

*361 

0 

*326 

0 

*397 

0 

*362 

0 

*327 

0 

*398 

0 

*363 

0 

*328 

0 

♦399 

0 

*364 

0 

*329 

0 

*400 

0 

*365 

9 

*330 

0 

*401 

0 

*366 

13 

*331 

0 

*402 

0 

*367 

13 

*332 

0 

*403 

0 

*368 

13 

*333 

0 

*404 

0 

*369 

13 

*334 

0 

*405 

0 

*370 

13 

*335 

0 

*406 

0 

*371 

13 

*336 

0 

*407 

0 

*372 

13 

*337 

0 

*408 

0 

*373 

13 

*338 

0 

*409 

0 

*374 

13 

*339 

0 

*410 

0 

*375 

13 

*340 

0 

*411 

0 

*376 

13 

*341 

0 

*412 

0 

*377 

13 

*342 

0 

*413 

0 

*378 

13 

*343 

0 

*414 

0 

*379 

13 

*344 

0 

*415 

0 

*380 

13 

*345 

0 

*416 

0 

*381 

13 

*346 

0 

*417 

0 

*382 

13 

*347 

0 

*418 

0 

*383 

13 

*348 

0 

*419 

0 

*384 

13 

*349 

0 

*420 

0 

*385 

13 

*350 

0 

♦421 

0 

*386 

13 

*351 

0 

*422 

0 

*387 

13 

*352 

0 

*423 

0 

*388 

12 

*353 

0 

*424 

0 

*389 

12 

*354 

0 

*425 

0 

*390 

12 

*426 

2 

*497 

13 

*462 

0 

*427 

2 

*498 

13 

*463 

0 

*428 

0 

*499 

13 

*464 

0 

*429 

0 

*500 

13 

*465 

0 

*430 

0 

*501 

13 

*466 

0 

*431 

0 

♦502 

13 

*467 

0 

*432 

0 

*503 

13 

*468 

0 

*433 

0 

*504 

13 

*469 

0 

*434 

0 

*505 

12 

*470 

0 

*435 

0 

*506 

12 

*471 

0 

*436 

0 

12 

*472 

*437 

0 

13 

*473 

*438 

0 

12 

*474 

*439 

0 

12 

*475 

*440 

0 

12 

*476 

*441 

0 

13 

*477 

♦442 

0 

13 

*478 

*443 

0 

13 

*479 

*444 

0 

13 

*480 

*445 

0 

13 

*481 

*446 

0 

13 

*482 

*447 

0 

13 

*483 

*448 

0 

13 

*484 

*449 

0 

13 

*485 

*450 

0 

13 

*486 

*451 

0 

7 

*487 

*452 

0 

13 

*488 

*453 

0 

2 

*489 

*454 

0 

9 

*490 

*455 

0 

5 

*491 

*456 

0 

0 

*492 

*457 

0 

2 

*493 

*458 

0 

2 

*494 

*459 

0 

2 

*495 

*460 

0 

2 

*496 

*461 

0 
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********************* 

***********************  SOURCE  ******************** 

ELECTRONS 

ENERGY  25.0 

POSITION  0.0  0.0  -0.5 

RADIUS  2.1 

DIRECTION  0 . 0 

**********************  OPTIONS  ******************* 
HISTORIES  100000 
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Appendix  2 


Annotated  ITS-ACCEPT  Program  Listings  Incorporating 
Disk  and  Rectangle  Source  Geometry  and 
Individual  History  Tracking  Options 


SUBROUTINE  INPUT 

INPUT 

00007 

c 

******************************************************* *************** input 

00009 

c 

INPUT 

00010 

c 

PROGRAM  INPUT  IS  CALLED  BY 

INPUT 

00011 

c 

ITS 

INPUT 

00012 

c 

PROGRAM  INPUT  CALLS 

INPUT 

00013 

c 

INTRINSIC  FUNCTIONS 

INPUT 

00014 

c 

REAL 

(TIGER  &  CYLTRAN) 

INPUT 

00015 

c 

SQRT,  ABS  (ACCEPT) 

INPUT 

00016 

c 

EXTERNAL  FUNCTIONS 

INPUT 

00017 

c 

ALIST, 

ELI ST,  START,  PREP,  KOP, 

INPUT 

00018 

c 

REQALL, 

GEOMIN,  SCRINF,  OPOPTS 

INPUT 

00019 

c 

KEYMAP, 

OPREAD 

INPUT 

00020 

c 

JOGEN 

(ACCEPT) 

INPUT 

00021 

c 

INPUT 

00022 

c 

ORIGINATION  DATE  12  DEC  67. 

INPUT 

00023 

c 

LAST  MODIFIED  17  MAY  91 

INPUT 

00024 

c 

INPUT 

00025 

c 

FUNCTION 

INPUT 

00026 

c 

THIS  PROGRAM  IS  USED  TO  READ 

AND  PROCESS  USER- SUPPLIED 

INPUT 

00027 

c 

CARD  INPUT 

INPUT 

00028 

c 

INPUT 

00029 

c 

************************************************ **********************input 

00030 

c 

***  COMMON  BLOCKS  CNSTNT,  PARAMS,  OUT,  CALC,  XPED,  STTS,  SCALE, 

PLTITLINPUT 

00031 

c 

PAREM,  GOMLOC  (ACCEPT) 

INPUT 

00032 

c 

FLUOR  (PCODES) 

INPUT 

00033 

c 

PLOT  (PLOTS) 

INPUT 

00034 

C$ 

!  LIST (S=0) 

INPUT 

00035 

CDIR$  NOLIST 

INPUT 

00036 

IMPLICIT  DOUBLE  PRECISION  (A-H,C 

>-Z) 

CNSTNT 

00081 

No  changes  in  CNSTNT  common  block  -  listing,  omitted  for  brevity,  is  identical  to 
that  given  in  Reference  1. 


SAVE 


C 

C 

C 

c 


I/O  UNIT  DECLARATIONS  AND  ARRAY  BUFFERS 
PARAMETER  (IIN  =  5,  IOUT  =  6,  ITP10  =  10, 
$  ITP14  =  14,  MAX KEY  =  3G)  = 


ITP11  =  11,  ITP12  =12, 


CNSTNT 

PARAMS 

PARAMS 

PARAMS 

PARAMS 

PARAMS 


00082 

00002 

00003 

00004 

00005 

onnns-s 


C 

PARAMS 

00008 

PARAMETER 

(  INMT=15 , 

INEM=8 , 

INMAX=64,  NSURV=2775 , 

PARAMS 

00009 

$ 

IMTOP= INMAX + 1 , 

IKTOP=8  9 , 

IMMAX=33 ,  INPANG=  2 1 , 

PARAMS 

00010 

$ 

INRANG=34,  INTANG=INMAX/4+l, 

INEEL= 13 ,  INPEL=2 1 , 

PARAMS 

00011 

$ 

INEPS=9, 

INGAS=1000 , 

INLAN=5000 ,  INPPS=21, 

PARAMS 

00012 

$ 

INLAMB=1591, 

JAHSUB=51, 

IJSPEC=51,  JATPR=698 , 

PARAMS 

00013 

$ 

JATAN=799,  INTAB = 

30,  IMTAX=64) 

STAN 

00001 

C 

TMJ :  END  OF  MODIFICATION 

STAN 

00002 

C 

PARAMS 

00015 

PARAMETER 

(  IMTOP1  *  IMTOP, 

INMAX 1  =  INMAX+1 ,  INMT PI  =  INMT+1, 

PARAMS 

00016 

$ 

INEEL 1  =  INEEL, 

INGAS 1  =  INGAS + 1 ,  INLAN1  =  INLAN+1 , 

,  PARAMS 

00017 

$ 

INEPS1  =  INEPS, 

NSURV1  =  NSURV+1, 

PARAMS 

00018 

$ 

INRNG1  =  INRANG 

,  INTNG1  =  INTANG  ) 

PARAMS 

00019 

C 

PARAMS 

00020 

PARAMETER 

(  KPTMAX=5000 , 

INSTAT=30 , 

PARAMS 

00021 

$ 

NCHANG= INPANG*  INRANG*  INTANG , 

NJAH1=NCHANG* INMT , 

PARAMS 

00022 

$ 

NBDIS  =  IKTOP* IMTOP, 

NJAH2 = NBDIS* INMT , 

PARAMS 

00023 

$ 

NGG  =  INMAX *IMMAX, 

NJAH3  =NGG*  INMT , 

PARAMS 

00024 

$ 

NJAH4  =  NSURV* INMT , 

NJAH5=JATPR*INMT  ) 

PARAMS 

00025 

Code 

modification 
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c 

c 


c 

c 


.  ARRAY  DIMENSIONS  FOR  ZONING  AND  ESCAPE  DISTRIBUTIONS 
PARAMETER  (  IKMAX  =  18,  IJMAX  =  50, 

$  IKPMAX  *  18,  IJPMAX  =  50, 

$  INIZON  =  901,  INSZON  =  900) 

PARAMETER  (  IKMX1  =  IKMAX+1,  IKPMX1  *  IKPMAX+1, 

$  IJMX1  =  IJMAX+1 ,  IJPMX1  =  IJPMAX+1 , 

$  IMMAX1  =  IMMAX+1  ) 

.  ARRAY  DIMENSIONS  FOR  PULSE-HEIGHT  AND  FLUX  DISTRIBUTIONS 


C 

c 


c 

c 

c 


c 

c 

c 

c 


c 

c 


PARAMETER  (  IJSMAX  =  160,  IJFMAX 
$  IJSMX1  =  I JSMAX+1 ,  IJFMX1 
$  I JFMXP  =  10,  IJFMP1 
$  IKFMAX  =  6 ,  IKFMXP 
$  IKFMX1  =  IKFMAX+1,  IKFMP1 
$  INLF  *  10,  INLFP 


=  10, 

=  UFMAX+1, 
=  IJFMXP+1, 
6, 

IKFMXP+1, 

=  10) 


COMMON  AZIMUTHAL  PARAMETERS  TO  FACILITATE  COMMON  CODING 
PARAMETER  (IKMAZ  =  1,  IKPMAZ  -  1) 

PARAMETER  ( IKFMAZ  =  1,  IKFMZP  =  1) 

PARAMETERS  SPECIFIC  TO  ACCEPT  AND  CYLTRAN 


PARAMETER  (IKMZ1 
$  IKFMZ1 

$  INPNTS 

$  NANGS 


IKMAZ+1,  IKPMZ1  *  IKPMAZ+1, 
IKFMAZ+1,  IKFPZ1  *  IKFMZP+1, 
500, 

360) 


ACCEPT  SPECIFIC  PARAMETERS 


PARAMETER  (NESC  =  1,  NESC1  *  NESC, 

$  INUMR  -  900,  NAZ  -=  5,  ITMA=  18000,  IFPD  =  6000, 

$  IJTY  -  500,  IARB  *  5,  NVTEWS  =  5,  NCZONE  =  60, 

$  INVALD  =  10,  INOFND  =  10) 

.  PARAMETERS  FOR  AUTOMATIC  SUBZONING 
PARAMETER  (  ILSUBZ=4) 


PARAMETER  (NLAST  =  50) 

PARAMETER  (  INUMK  *  3,  INGP  -  INMT) 

LOGICAL  RRKILL,  FLMTEL 

No  changes  in  OUT  common  block  -  listing,  omitted  for  brevity,  is 
given  in  Reference  1 . 

COMMON  /OUT/ 


PARAMS  00026 
PARAMS  00027 
PARAMS  00028 
PARAMS  00029 
PARAMS  00030 
PARAMS  00031 
PARAMS  00032 
PARAMS  00033 
PARAMS  00034 
PARAMS  00035 
PARAMS  00036 
PARAMS  00037 
PARAMS  00038 
PARAMS  0003  9 
PARAMS  00040 
PARAMS  00041 
PARAMS  00042 
PARAMS  00043 
PARAMS  00044 
PARAMS  00045 
PARAMS  00046 
PARAMS  00048 
PARAMS  00049 
PARAMS  00050 
PARAMS  00051 
PARAMS  00052 
PARAMS  00053 
PARAMS  00054 
PARAMS  00055 
PARAMS  00077 
PARAMS  00078 
PARAMS  00079 
PARAMS  00080 
PARAMS  00081 
PARAMS  00082 
PARAMS  00083 
PARAMS  00084 
PARAMS  00085 
PARAMS  00086 
PARAMS  00089 
PARAMS  00103 
OUT  00002 

identical  to  that 


c 

C 


CHARACTER* 80  TITLE 
COMMON  /PLTITL/  TITLE 


COMMON  /CALC/ 

No  changes  in  CALC  common  block  -  listing,  omitted 
that  given  in  Reference  1. 


OUT 

PLTITL 

PLTITL 

PLTITL  ' 

PLTITL 

CALC 

CALC 

for  brevity,  is 


00003 

00002 

00003 

00004 

00005 

00002 

00003 

identical  to 


C 

C 


COMMON  /XPED/ 

1  DETOUR (INMT) ,  RHO (INMT) ,  MT,  MTP , 

LOGICAL  DMPFLG ,  FLMC 
DOUBLE  PRECISION  IRSAV 
COMMON  /STTS/  IB,  NB,  NSORS,  3 
$  ,  IHIST,  IRSAV,  KPUT,  FLMC 


MTP0 


COMMON  / SUBZ/  NSUBZ (INIZON)  , 

1  f  NX (ILSUBZ) ,  XH(ILSUBZ) 

2  NY (ILSUBZ) ,  YH{ ILSUBZ)  , 

3  NZ ( ILSUBZ ) ,  ZH ( ILSUBZ ) 

$  ,  EPS1X (ILSUBZ) ,  EPS 1Y ( ILSUBZ ) ,  EPS1Z (ILSUBZ) 


ZFAC( ILSUBZ) 
XFAC( ILSUBZ) , 
YFAC (ILSUBZ) , 


CALC 

00139 

XPED 

00002 

XPED 

00003 

XPED 

00010 

XPED 

00012 

STTS 

00002 

STTS 

00010 

KPUTMX,  DMPFLG  STTS 

00017 

STTS 

00018 

STTS 

00019 

SUBZ 

00002 

SUBZ 

00003 

SUBZ 

00005 

SUBZ 

00006 

SUBZ 

00007 

SUBZ 

00009 
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C$ 


$  EPS2X ( ILSUBZ) ,  EPS2Y (ILSUBZ) , 

EPS2Z (ILSUBZ) 

SUEZ 

00010 

PAREM 

00002 

CHARACTER* 3  OTYPE(lO),  OBODY 

PAREM 

00003 

LOGICAL  FLDBG,  FLDBGL 

PAREM 

00004 

COMMON  /PAREM/ 

PAREM 

00008 

$  XB (3) ,  WT (3) ,  RIN,  ROUT, 

PINF,  DIST, 

IR, 

PAREM 

00009 

$  FLDBG,  IRPRIM,  I CALL,  LSURF, 

NBO,  LRI, 

LRO, 

PAREM 

00013 

$  KLOOP,  LOOP,  ITYPE,  FLDBGL 

PAREM 

00014 

COMMON  /PAREMO/  OTYPE 

PAREM 

00015 

PAREM 

00016 

GOMLOC 

00002 

COMMON  /GOMLOC/ 

GOMLOC 

00003 

$  LDATA,  LTMA,  LFPD,  NUMR,  NUMB,  LDATP1 ,  LTMAM1, 

GOMLOC 

00004 

$  NVALD,  NOFND 

GOMLOC 

00005 

GOMLOC 

00006 

PLOT 

00002 

COMMON  /PLOT/  NPLOTS,  PHIPLT (NVIEWS) ,  THEPLT (NVIEWS) , 

PLOT 

00003 

$  XMNPLT  (NVIEWS )  ,  XMXPLT  (NVIEWS ) 

,  YMNPLT  (NVIEWS)  , 

YMXPLT  (NVIEWS) 

,  PLOT 

00004 

$  XMN,  XMX,  YMN,  YMX,  KPLT 

PLOT 

00005 

LIST (S=l) 

INPUT 

00051 

;  LIST 

INPUT 

00052 

COMMON  /SCALE/  BNUM,  XNUM 

SCALE 

oocm- 

COMMON  /EXTSORC/  IRECTS , IDISKS , XLOWS , XHIGHS , YLOWS , YHIGHS , ZLOWS , 

$  ZHIGHS ,  XCENT ,  YCENT ,  ZCENT ,  XCIR ,  YCIR ,  ZCIR ,  KPERPYZ ,  KPREPXZ ,  KPERPXY 


COMMON  /HITS/EDPR (10)  ,EDNK(10)  ,EDSC(10)  ,EDTL(10)  ,LHCL(10)  ,NINDV 


CHARACTER* 80  KARD 

COMMON  /  IOPACK  /  KARD 

LOGICAL  EOFLAG ,  FLKEY (MAXKEY) ,  FLDUP,  FLNEWD 


WRITE (TOUT, ' ( 


INPUT 
INPUT 
INPUT 
INPUT 
INPUT 
INPUT 
INPUT 
INPUT 
INPUT 

********************************  *************  * ********** *****  +  **xnput 
*  CONVERT  UNITS  FROM  CM  BACK  TO  GM/CM**2  FOR  MULTIPLE  PROBLEMS  *  INPUT 
****************************************************************  INPUT 

INPUT 


IF  (IRUN  .NE. 


r » 2*************************** 1 1 / 

'  ■  *  BEGIN  READING  INPUT  *  1  *  / 

>  i  ****************************  »)  ») 

1)  THEN 


DO  50  L=1,NMT 
RHOL  =  RHO(L) 

DO  10  N=1 , NMAX1 


RANGE (N,L) 
DRG (N, L) 


=  RANGE (N,L)*RHOL 
=  DRG (N, L)  *RHOL 


PXRAY (N, L)  =  PXRAY (N, L) /RHOL 


10 


20 


30 

50 


PBREM  (N,  L)  = 
CONTINUE 
DO  20  N=1,NMAX 
DRGS  (N,  L) 


PBREM  (N,  L)  /RHOL 


C 

C 

C 


DRGS  (N,  L)  *RHOL 
COSAV (N,  L)  =  COSAV (N,  L)  /RHOL 
CONTINUE 

DO  30  J-l,  NGMAX 

AT  ( J,  L)  AT(J,L)/RHOL 

CONTINUE 
CONTINUE 
END  IF 

********************************** 

*  SET  DEFAULT  INPUT  PARAMETERS  * 
********************************** 


INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 


New  code 


New  code 


00058“- 

00059 

00060 

00061 

00062 

00063 

00064 

00065 

00066 

00067 

00068 

00069 

00070 

00071 

00073 

00074 

00075 

00076 

00077 

00078 

00079 

00080 

00081 

00082 

00083 

00084 

00085 

00086 

00087 

00088 

00133 

00134 

00135 


FLSTRG 

= 

.TRUE. 

INPUT 

00136 

FLNOK 

= 

.TRUE. 

INPUT 

00137 

FLNEL 

= 

.FALSE. 

INPUT 

00138 

FLBAD 

= 

.TRUE. 

INPUT 

00139 

FLGSEC 

= 

.TRUE. 

INPUT 

00140 

FLNXEV 

= 

.FALSE. 

INPUT 

00141 

FLBSC 

.FALSE. 

INPUT 

00142 

FLCOH 

= 

.TRUE. 

INPUT 

00143 

FLSKN 

= 

.TRUE. 

INPUT 

00144 

FLDBG 

= 

. FALSE . 

INPUT 

00146 
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FLDBGL  -  .FALSE 
RLAN  =  C5EM1 

BNUM  =  CZERO 

XNUM  =  CZERO 

DLIM  «=  CZERO 

NPRTCL  *  1 


TITLE  e  •  * 

NPRT  *  12 

IECHO  =  0 

NB  =  10 

I MAX  *  1000 

IBT  «=  0 

MBSC  =  1 

BOLD  =  CZERO 

IMXOLD  =  0 

INRAN  «  CZERO 

BASE  «=  CTWO 

XNCYC  *  CEIGHT 

TMFAC  *  BASE** ( -1 . 0 /XNCYC) 

DMPFLG  =  .FALSE. 

C 

C  . . .  INITIALIZE  LOGICALS  FOR  IDENTIFYING  MATERIALS  {NON-P  CODES)  OR 
C  ELEMENTS  (P  CODES)  THAT  ARE  PRESENT  IN  A  GIVEN  PROBLEM  -  USED 
C  FOR  IDENTIFYING  RELEVANT  LINE  RADIATION. 

NGP  -  NMT 
DO  60  J=l, NGP 
60  FLMTEL(J)  *  .FALSE. 

C 

NPLOTS  -  0 


.  . •  SOURCE  VARIABLES 


FLESRC  =  . TRUE . 
JSPEC  -  0 
FLSPEC  *  .FALSE 
TIN  *  CONE 
TPCUT  -  C1EM2 
TCUT  *  CZERO 
TSAVE  *  CZERO 
ICTH  *  1 
CTSR  *  CZERO 
CTHIN  «=  C90 
ZSR  -  CZERO 
XSR  «  CZERO 
YSR  *  CZERO 
CPSR  *  CZERO 
SORCIN  =  CZERO 


ELECTRON  ESCAPE  VARIABLES 

JMAX 

s 

10 

FLESC 

= 

.FALSE. 

ITMK 

MS 

1 

IAMK 

MS 

1 

KMAX 

MS 

18 

KMAZ 

s 

1 

IAMKZ 

m. 

1 

PHOTON  ESCAPE  VARIABLES 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 


INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 


00147 

00149 

00150 

00151 

00152 

00153 


00154 

00155 

00156 

00157 

00158 

00159 

00160 

00161 

00162 

00163 

00168 

00170 

00171 

00172 

00173 

00174 

00175 

00176 

00177 

00182 

00184 

00185 

00186 

00188 

00193 

00194 

00195 

00196 

00197 

00198 

00199 

00200 

00201 

00202 

00203 

00204 

00205 

00210 

00213 

00214 

00215 

00216 

00218 

00219 

00220 

00221 

00222 

00223 

00224 

00225 

00226 

00228 

00230 

00231 

00232 
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JPMAX 

= 

10 

FLESCP 

35 

.FALSE. 

IPMK 

= 

1 

IBMK 

= 

1 

KPMAX 

S 

18 

KPMAZ 

= 

1 

IBMKZ 

= 

1 

ELECTRON 

FLUX  VARIABLES 

FLFLUX 

— 

.FALSE. 

JFMAX 

= 

10 

KFMAX 

= 

6 

KFMAZ 

= 

1 

IFAMKZ 

= 

1 

IFMK 

- 

1 

IFAMK 

= 

1 

PHOTON 

FLUX  VARIABLES 

FLFLXP 

= 

. FALSE . 

JFMAX P 

= 

10 

KFMAX P 

= 

6 

KFMAZP 

S 

1 

IFBMKZ 

= 

1 

IFMKP 

= 

1 

IFBMK 

1 

. . .  PULSE  HEIGHT  DISTRIBUTION  VARIABLES 


FLPHD  =  .FALSE. 
JSMAX  =  12 
IPHMK  =  1 


**********+*********★************************** 

*  BEGIN  READING  INPUT  * 

*  ZERO -LEVEL  KEYWORDS  IN  ALPHABETICAL  ORDER  * 
************ *********************************** 


. . .  SET  ERROR  TRAP  FLAG  TO  ZERO 
IERTRP  =  0 
NUMCRD  =  0 
FLNEWD  *  . FALSE . 

FLDUP  =  .FALSE. 

DO  65  IKEY=1 , MAXKEY 
65  FLKEY(IKEY)  =  .FALSE. 

.  .  .  READ  THE  NEXT  CARD  IN  THE  INPUT  FILE 


C 

C 

C 

C 


C 

C 

c 

c 

c 

c 

c 

c 

c 


70  CALL  OPREAD ( 1 , IECHO , EOFLAG) 

...  NOTE,  COMMENT  CARDS  DENOTED  BY  *  IN  COLUMN  1,  SKIPPED  INTERNALLY 

IF  (.NOT.  EOFLAG)  THEN 
NUMCRD  =  NUMCRD  +  1 

80  IF  (KOP(* BATCHES’)  .GE.  1)  THEN 

. . .  BATCHES 

Check  if  primary  keyword  has  been  used 
I KEY  =  l 

IF  (FLKEY(IKEY) )  CALL  KEYMAP ( IKEY , FLDUP) 

FLKEY(IKEY)  =  .TRUE. 

NB  *  PARM(l) 


INPUT 

00233 

INPUT 

00234 

INPUT 

00235 

INPUT 

00236 

INPUT 

00237 

INPUT 

00238 

INPUT 

00240 

INPUT 

00242 

INPUT 

00243 

INPUT 

00244 

INPUT 

00245 

INPUT 

00246 

INPUT 

00247 

INPUT 

00248 

INPUT 

00250 

INPUT 

00252 

INPUT 

00253 

INPUT 

00254 

INPUT 

00255 

INPUT 

00256 

INPUT 

00257 

INPUT 

00258 

INPUT 

00259 

INPUT 

00260 

INPUT 

00262 

INPUT 

00264 

INPUT 

00265 

INPUT 

00266 

INPUT 

00267 

INPUT 

00268 

INPUT 

00269 

INPUT 

00270 

INPUT 

00271 

INPUT 

00272 

INPUT 

00273 

INPUT 

00274 

INPUT 

00275 

INPUT 

00276 

INPUT 

00280 

INPUT 

00281 

INPUT 

00282 

INPUT 

00283 

INPUT 

00284 

INPUT 

00285 

INPUT 

00286 

INPUT 

00287 

INPUT 

00288 

INPUT 

00289 

INPUT 

00290 

INPUT 

00291 

INPUT 

00292 

INPUT 

00293 

INPUT 

00294 

INPUT 

00295 

INPUT 

00296 

INPUT 

00297 

INPUT 

00298 

INPUT 

00299 

INPUT 

00300 

INPUT 

00301 

INPUT 

00302 

INPUT 

00303 

INPUT 

00304 

INPUT 

00305 

INPUT 

00306 

INPUT 

00307 

INPUT 

00308 

INPUT 

00309 

INPUT 

00310 

INPUT 

00311 

INPUT 

00312 

49 


ooon\  noon  noon  nnonon 


c 


ELSE  IF  (KOP( • CUTOFFS* )  .GE.  0)  THEN 


CUTOFFS 


I KEY  =  2 

IF  {FLKEY (IKEY) )  CALL  KEYMAP ( I KEY , FLDUP ) 


FLKEY(IKEY)  =  .TRUE. 

KARG  =  KOP { ' CUTOFFS  * ) 

IF  (KARG  .GE.  1)  THEN 
TCUT  =  PARM (1) 

END  IF 

IF  (KARG  .GE.  2)  THEN 
TP CUT  =  PARM (2) 

END  IF 

ELSE  IF  ( KOP ( 'DETAIL- IONIZE’ )  .GE.  0)  THEN 


DETAIL- IONIZATION 
IKEY  *  33 

IF  (FLKEY  (IKEY)  )  CALL  KEYMAP  (IKEY,  FLDUP) 
FLKEY  (IKEY)  =  .TRUE. 

NPRTCL  -  2 


INPUT 

00313 

INPUT 

00314 

INPUT 

00315 

INPUT 

00316 

INPUT 

00317 

INPUT 

00318 

INPUT 

00319 

INPUT 

00320 

INPUT 

00321 

INPUT 

00322 

INPUT 

00323 

INPUT 

00324 

INPUT 

00325 

INPUT 

00326 

INPUT 

00327 

INPUT 

00328 

INPUT 

00329 

INPUT 

00330 

INPUT 

00331 

INPUT 

00332 

INPUT 

00333 

INPUT 

00334 

INPUT 

00335 

INPUT 

00336 

INPUT 

00337 

INPUT 

00338 

INPUT 

00339 

INPUT 

00340 

INPUT 

00341 

INPUT 

00342 

INPUT 

00343 

ELSE  IF  ( KOP ('RECTANGLE- SOURCE' ) .GE.O) THEN 


RECTANGULAR  PLANE  SOURCE 


IKEY  *  34 
C 

C 

IF  (FLKEY  (IKEY})  CALL  KEYMAP  ( IKEY,  FLDUP) 

C  _ 

FLKEY (IKEY)  =  .TRUE. 

C 


KARG  -  KOP ( 'RECTANGLE -SOURCE') 
IF ( KARG . LT . 6 ) THEN 

WRITE (IOUT, 68 ) 


68  FORMAT  ( IX ,  •»»>•) 

WRITE (IOUT, 51) 

WRITE { IOUT ,68) 

51  FORMAT  ( IX ,  '  USER  MUST  ENTER  6  NUMBERS  (XLOW,  XHIGH,  YLOW,  YHIGH,  ZLOW, 

$ZHIGH)  TO  DEFINE  SOURCE  LOWER  AND  UPPER  COORDINATE  LIMITS  OF  SOURC 
$E  RECTANGLE') 

CALL  ABORTX  (  *  INPUT ' ) 

ELSE 

IRECTS  «  1 
XLOWS  -  PARM (1) 

XHIGHS  =  PARM (2) 


50 


V  V 


c 

ELSE  IF  (KOP (' CIRCLE -SOURCE* ) .GE.O) THEN 
C  _ 


C  CIRCLE  PLANE  SOURCE 

C  - 


c 


I KEY  =  35 


IF  (FLKEY(IKEY) )  CALL  REYMAP { I KEY, FLDUP) 


FLKEY {I KEY)  =  .TRUE. 


KARG  =  KOP ( 'CIRCLE -SOURCE’ ) 

IF (KARG . LT . 6 ) THEN 

WRITE (IOUT, 68) 

WRITE (IOUT, 52) 

WRITE (IOUT, 68) 

52  FORMAT  (IX,  '  USER  MUST  ENTER  6  NUMBERS  -  COORDINATES  OF  CIRCLE  CENT 
$ER  (XO,YO,ZO)  ,  AND  COORDINATES  A  POINT  ON  CIRCUMFERENCE 1  / IX,  '  (XC,  YC 
$,ZC)  TO  DEFINE  POSITION  AND  ORIENTATION  OF  SOURCE  CIRCLE') 


CALL  ABORTX ( ' INPUT ' ) 

ELSE 

IDISKS  =  1 
XCENT  =  PARM(l) 

YCENT  =  PARM (2 ) 

ZCENT  =  PARM (3) 

XCIR  =  PARM (4) 

YCIR  *=  PARM (5) 

ZCIR  =  PARM (6) 

CALL  OPREAD ( 1 , IECHO , EOFLAG) 
IF (KOP ('RADIUS ') .GE.l)  THEN 
SORCIN  =  PARM (1) 

ELSE 
GO  TO  80 
END  IF 


C 


END  IF 


C 

C 

C 

C 

c 


ELSE  IF  (KOP ( ' INDIVIDUAL -HI STS ' ) .GE.O)  THEN 


RECORD  SINGLE  HISTORY  ENERGY  DEPOSITIONS 


I KEY  =  36 


IF  (FLKEY ( IKEY) )  CALL  KEYMAP ( IKEY, FLDUP) 

C 

FLKEY (IKEY)  =  .TRUE. 

C 

KARG  =  KOP ( *  INDIVIDUAL -HI STS ' ) 

IF ( KARG . LT . 1 . OR .  KARG. GT. 10) THEN 
WRITE (IOUT, 68) 

WRITE (IOUT, 688) 

WRITE (IOUT, 68) 

688  FORMAT ( IX ,  'USER  MUST  ENTER  NO  FEWER  THAN  1  AND  NO  MORE  THAN  10  CEL 

$L  NUMBERS  IN  WHICH  THE  ENERGY  DEPOSITION' / IX,  'FOR  INDIVIDUAL  ELECT 
$RON  HISTORIES  ARE  TO  BE  RECORDED .  ' )  J 

C  / 
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CALL  ABORTX ( *  INPUT ' ) 

ELSE 

DO  689  KRRG= 1 , KARG 
LHCL (KRRG) =  PARM ( KRRG ) 

NINDV=KARG 
WRITE (IOUT,  587) 

WRITE (IOUT, 588) (LHCL (KRRG) , KRRG=1 ,NINDV) 

FORMAT (IX, 'ENERGY  DEPOSITION  FOR  INDIVIDUAL  HISTORIES 
$RDED  ON  FILE  "ED SHOW. TXT"  FOR  CELL  NOS /5X , 1015) 

WRITE (IOUT, 587) 

FORMAT (/IX,1 *****************************************! 
$******+*****+****++++++*+*++++  **********  ★♦*****♦***♦*1 
$/lX, ' ******************************* *********★*******, 

^***t******«****4********4rt«it1rttitti|rillttt44tAiiitA#AA< 

END  IF 


New  code 


WILL  BE 


C 

ELSE  IF  (KOP( 'DIRECTION')  .GE.  0)  THEN  INPUT  00344 

C  INPUT  00345 

C  . . .  DIRECTION  INPUT  00346 

C  INPUT  00347 

IKEY  =  3  INPUT  00348 

C  _  INPUT  00349 

IF  (FLKEY(IKEY)  )  CALL  KEYMAP  ( IKEY,  FLDUP)  INPUT  00350 

C  -  INPUT  00351 

FLKEY(IKEY)  =  .TRUE.  INPUT  00352 

C  INPUT  00353 


Remaining  portion  of  subroutine  INPUT  (omitted  here  for  brevity)  is 
identical  to  original  ACCEPT  [1]  code 


END 


INPUT 


01841 


SUBROUTINE  HIST  HIST  00007 

C  ***************************************** *****************************HIST  00009 


C 

HIST 

00010 

C 

SUBROUTINE  HIST  IS  CALLED  BY 

HIST 

00011 

C 

ITS 

HIST 

00012 

C 

SUBROUTINE  HIST  CALLS 

HIST 

00013 

C 

INTRINSIC  FUNCTIONS 

HIST 

00014 

c 

SQRT,  RANF 

HIST 

00015 

c 

REAL 

(CYLTRAN) 

HIST 

00016 

c 

EXTERNAL  FUNCTIONS 

HIST 

00017 

c 

CLASS,  ECROS,  EHIST ,  TIMER,  PHIST 

HIST 

00018 

c 

RANINT,  RANSAV 

HIST 

00019 

c 

ZONE 

(CYLTRAN) 

HIST 

00020 

c 

FOLD,  ZONEA 

(ACCEPT) 

HIST 

00021 

c 

PLTDAT 

(M-CODES) 

HIST 

00022 

c 

HIST 

00023 

c 

ORIGINATION  DATE  16  JAN  68. 

HIST 

00024 

c 

LAST  MODIFIED  30  MAY  91 

HIST 

00025 

c 

HIST 

00026 

c 

FUNCTION 

HIST 

00027 

c 

THIS  PROGRAM  SAMPLES  PHASE  SPACE  PARAMETERS  FOR 

HIST 

00028 

c 

SOURCE  PARTICLES.  SUBSEQUENTLY  CALLS 

EITHER  EHIST  OR 

HIST 

00029 

c 

PHIST.  RETRIEVES  "BANKED"  ELECTRONS 

AND  CALLS  EHIST. 

HIST 

00030 

c 

TALLIES  PULSE  HEIGHT  DISTRIBUTION. 

HIST 

00031 

c 

HIST 

00032 

c  *** 

****************************************** ******* ******************hist 

00033 

c  *** 

COMMON  BLOCKS  CNSTNT,  PARAMS,  OUT,  CALC, 

XPED,  STOR,  STTS, 

HIST 

00034 

c 

(PAREM) -ACCEPT 

HIST 

00035 

C$ 

LIST (S=0 ) 

HIST 

00036 

CDIR$ 

NOLIST 

HIST 

00037 

IMPLICIT  DOUBLE  PRECISION  (A-H,0-Z) 

CNSTNT 

00081 

No  changes  in  CNSTNT  common  block  -  listing,  omitted  for  brevity,  is  identical  to 
that  given  in  Reference  1 . 

PARAMETER  (CCOHLM=57 . 031547D0 ,  CCOHMX=80 . 654788D0 )  CNSTNT  00140 


C  PARAMS  00002 

C - PARAMS  00003 

C  PARAMS  00004 


C  .  .  .  I/O  UNIT  DECLARATIONS  AND  ARRAY  BUFFERS  PARAMS  00005 

PARAMETER  (IIN  *  5,  IOUT  =  6 ,  ITP10  =  10 ,  ITP11  =  11 ,  ITP12  =  12,  PARAMS  00006 


PARAMS  common  block  identical  to  that  shown  in  subroutine  INPUT 

COMMON  /EXTSORC/  IRECTS ,  IDISKS ,  XLOWS ,  XHIGHS ,  YLOWS  ,  YHIGHS ,  ZLOWS , 

$  2HIGHS ,  XCENT ,  YCENT ,  ZCENT ,  XCIR,  YCIR ,  ZCIR ,  KPERPYZ ,  KPREPXZ ,  KPERPXY 
LOGICAL  RRKILL,  FLMTEL  OUT 

COMMON  /OUT/  OUT 


New 

oooo3  i  Code 


No  changes  in  OUT  common  block  -  listing,  omitted  for  brevity,  is  identical  xo-that- 
given  in  Reference  1. 


CALC 

CALC 


COMMON  /CALC/ 

No  changes  in  CALC  common  block  -  listing,  omitted  for  brevity,  is 
that  given  in  Reference  1. 


00002 

00003 

identical  to 


C 

XPED 

00002 

COMMON  /XPED/ 

XPED 

00003 

1  DETOUR (INMT)  ,  RHO(INMT),  MT,  MTP,  MTPO 

XPED 

00010 

C 

XPED 

00012 

LOGICAL  DMPFLG,  FLMC 

STTS 

00002 

DOUBLE  PRECISION  IRSAV 

STTS 

00010 

COMMON  /STTS/  IB,  NB,  NSORS ,  IBT,  BOLD,  BATCH, 

KPUTMX, 

DMPFLG  STTS 

00017 

$  ,  IHIST,  IRSAV,  KPUT,  FLMC 

STTS 

00018 

C 

STTS 

00019 

c 

PAREM 

00002 

CHARACTER* 3  OTYPE(lO),  OBODY 

PAREM 

00003 

LOGICAL  FLDBG,  FLDBGL 

PAREM 

00004 

COMMON  /PAREM/ 

PAREM 

00008 

$  XB (3 ) ,  WT (3 ) ,  RIN,  ROUT,  PINF,  DIST, 

IR, 

PAREM 

00009 

53 


$  FLDBG,  IRPRIM,  I CALL, 

$  KLOOP,  LOOP,  I TYPE, 

COMMON  /PAREMO/  OTYPE 
C 

COMMON  /HITS/EDPR ( 10 ) 
C$  LIST (S=l) 

CDIR$  LIST 

COMMON  /STOR/ 

1  CTHS (NLAST) ,  TS (NLAST) , 

2  LBS (NLAST) ,  NTS (NLAST) 

$  ,XS (NLAST),  YS (NLAST), 

3  CPHS (NLAST),  S PH S (NLAST) 

4  ,LBCS (NLAST) 


WS (NLAST),  ZS  (NLAST),  IPRS (NLAST)  ( 
STHS (NLAST)  , 


EXTERNAL  RAN 

CIMAX  -  IMAX 
IF  (FLSPEC)  THEN 
TAV  =  CZERO 
ELSE 

TAV  =  CIMAX*TIN 
END  IF 

CALL  RANINT  ( IRA) 


IF 

DO 


(IB 

130 


.EQ.  1)  INRAN  =  IRA 
[  «  1.  IMAX 


DO  1301  JJJ=1,10 
EDPR ( JJJ) =0 . 
EDNK(JJJ) =0 . 
EDSC (JJJ) =0 . 
EDTL  (JJJ)  a=0 . 

IhitiT  =  1  ' 


LSURF,  NBO,  LRI ,  LRO,  PAREM 

FLDBGL  PAREM 

PAREM 

PAREM 

EDNK(10) , EDSC (10) ,EDTL(10) ,LHCL(10) ,NINDV 

HIST 
HIST 
STOR 
STOR 
STOR 
STOR 
STOR 
STOR 
HIST 
RANNUM 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 


1301 


-T 


New 
1  Code 


MODTMJ  =  MIN (100, IMAX) 

IF ( I . EQ . MODTMJ* ( I /MODTMJ) )  THEN 
CALL  TOTTIM (XTMJ) 

WRITE (*,*(/' 1  HISTORY* '  , 18, 1 1 ,  ELAPSED  MINUTES **, F10 . 2 )' ) 
II , XTMJ/60 . 

END  IF 

W  *  CONE 

CWCF  «  W 
LAST  «  0 


C 

c 

c 

c 

c 


CALL  RANSAV  ( IRSAV) 


SOURCE  ENERGY 


14 

16 


IF  (FLSPEC)  THEN 
RA  =  RAN (IRAN) 

DO  14  JHIST  =  2 , JSPEC 

IF  (  RA.  GT.  SPECIN (JHIST)  )  GO  TO  16 
CONTINUE 

T  «  BSP ( JHIST-1)  +  (  RA  -SPECIN (JHIST- 1)  )*(  ESP(JHIST) 
-  ESP ( JHIST-l)  )/(  SPECIN (JHIST)  -  SPECIN (JHIST- 1)  ) 
TAV  *  TAV  +  T 

IF  (  (FLESRC  .AND.  (T  .GT.  TCUT  ))  .OR. 

(.NOT.  FLESRC  .AND.  (T  .GT.  TPCUT) )  )  THEN 


20 


GO  TO 

ELSE 

NTREJ 
TREJ 
GO  TO 
END  IF 
END  IF 
T  ■  TIN 
NT  *  NTFST 


20 

=  NTREJ  h 
*  TREJ  + 
1299 


1 

W*T 


C 

C 


CALL  CLASS  (T,  NT) 


HIST 

LAHEY 

LAHEY 

LAHEY 

LAHEY 

LAHEY 

LAHEY 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 


00047 

00048 

00002 

00003 

00004 

00006 

00007 

00009 

00050 

00003 

00089 

00090 

00091 

00092 

00093 

00094 

00095 

00096 

00097 

00098 

00101 

00103 


00104 

00017 

00018 

00019 

00020 

00021 

00022 

00105 

00106 

00107 

00108 

00109 

00110 

00111 

00112 

00113 

00114 

00115 

00116 

00117 

00118 

00119 

00120 

00121 

00122 

00123 

00124 

00125 

00126 

00127 

00128 

00129 

00130 

00131 

00132 

00133 

00134 

00135 

00136 
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oonno  n  non 


SOURCE  DIRECTION 


IF  (ICTH  .EQ.  2)  THEN 
RA  =  RAN  (IRAN) 

COM  =  CTHIN+  RA*  (CONE-CTHIN) 


HIST 

HIST 

HIST 

HIST 

HIST 

HIST 


ELSE  IF  (ICTH  .EQ.  3)  THEN 

HIST 

RA  =  RAN  ( IRAN) 

HIST 

COM  =  SQRT(CTHIN+RA*  (CONE-CTHIN)  ) 

HIST 

ELSE  IF  (ICTH  .EQ.  1)  THEN 

HIST 

CTH (1)  =  CTSR 

HIST 

STH { 1)  =  STSR 

HIST 

CPH { 1 )  =  CPSR 

HIST 

SPH ( 1)  =  SPSR 

HIST 

GO  TO  69 

HIST 

END  IF 

HIST 

HIST 

IF  (CTSR  .EQ.  CONE)  THEN 

HIST 

CTH ( 1)  *  COM 

HIST 

STH (1)  =  SQRT ( CONE - COM * COM ) 

HIST 

RA  =  RAN  (IRAN) 

HIST 

JAZ  =  RA*C360 

HIST 

CPH (1)  =  CCH (JAZ+1) 

HIST 

SPH (1)  =  SCH (JAZ+1) 

HIST 

ELSE 


CALL  FOLD ( CTSR , STSR , CPSR , SPSR , COM , CTH ( 1 ) 


END  IF 


. . .  SOURCE  POSITION 


69  IF  (SORCIN  .NE.  CZERO)  THEN 

RA  «  RAN  (IRAN) 

R  =  SQRT (RA) * SORCIN 
RA  =  RAN  (IRAN) 

JAZ  =  RA*C360 

SCHR  =  SCH ( JAZ+1) *R 

CCHR  =  CCH (JAZ+1) *R _ 


HIST 

_ HIST 

,  STH (1) , CPH ( 1 ) , SPH ( 1) ) HIST 

- HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 


IF  (IDISKS  .EQ.  0)  THEN 

X  -  XSR  +  CCHR*W1X+SCHR*W2X 

Y  =  YSR+ CCHR* W1Y+ SCHR* W2Y 

Z  =  ZSR+CCHR*W1Z+SCHR*W2Z 

ELSE 

I F ( KPERPXY . EQ . 1 ) THEN 
X  =  XCENT  +  CCHR 

Y  =  YCENT  +  SCHR 
Z  =  ZCENT 

END  IF 

IF  ( KPERPXZ . EQ . 1 ) THEN 
X  =  XCENT  +  CCHR 

Y  =  YCENT 

Z  =  ZCENT  +  SCHR 
END  IF 

IF ( KPERPYZ . EQ . 1 ) THEN 


XCENT 
Y  = 


YCENT  +  CCHR 


Z  =  ZCENT  +  SCHR 


END  IF 


IF  (IRECTS  .EQ.  0)  THEN  HIST 
X  =  XSR  HIST 
Y  =  YSR  HIST 
Z  =  ZSR  HIST 


00137 

00138 

00139 

00140 

00141 

00142 

00143 

00144 

00145 

00146 

00147 

00149 

00150 

00151 

00153 

00154 

00155 

00156 

00157 

00159 

00160 

00161 

00162 

00163 

00165 

00172 

00173 

00174 

00176 

00177 

00178 

00179 

00198 

00199 

00200 

00201 

00202 

00203 

00204 


00208 

00209 

00210 

00211 
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c 

XB ( 1)  =  X 
XB (2)  *  Y 
XB  (3)  *  Z 

WT(1)  =  STH (l) *CPH { 1) 

WT(2)  =  STH  (1)  *SPH  ( 1) 

WT (3 )  =  CTH(l) 

C  _ 

CALL  ZONEA 

C  - - 

LB  -  IR 
LBCZ  *  IRPRIM 
I  PR  =  1 
C 

C  _ 

C  . . .  CALL  TRACKING  ROUTINES 

C - - 

70  IF  (  FLESRC  .OR.  (IPR  .NE.  1)  )  THEN 


PARTICLE  TO  BE  TRACKED  IS  AN  ELECTRON 


IF  (MT  .NE.  MAT  (LB)  )  THEN 
MT  =  MAT (LB) 

END  IF 


CALL  EHIST 


ELSE 


PARTICLE  TO  BE  TRACKED  IS  A  PHOTON 


LPCZ  =  LBCZ 

C  __ _ 

CALL  PHIST  (X,  Y,  Z,  LB ,  CTH  ( 1) , STH(l) ,CPH(1) ,SPH(1) ,T,W,1) 


END  IF 
C 


HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 


00212 

00213 

00220 

00221 

00222 

00223 

00224 

00225 

00226 

00227 

00228 

00229 

00230 

00232 

00233 

00234 

00235 

00236 

00237 

00238 

00239 

00240 

00241 

00242 

00248 

00249 

00250 

00251 

00252 

00253 

00254 

00255 

00262 

00265 

00266 

00267 

00269 

00270 
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REMOVE  SECONDARY  ELECTRONS  FROM  STORAGE  FOR  TRANSPORT 

IF  (LAST  .NE.  0)  THEN 
LB  =  LBS (LAST) 

2  =  ZS (LAST) 

T  =  TS  (LAST) 

NT  =  NTS (LAST) 

CTH(I)  =  CTHS(LAST) 

W  =  WS  (LAST) 

IPR  =  IPRS (LAST) 

X  =  XS (LAST) 

Y  =  YS (LAST) 

STH(l)  =  STHS (LAST) 

CPH{1)  *  CPHS (LAST) 

SPH(l)  =  SPHS (LAST) 

LBCZ  =  LBCS (LAST) 

KLOOP  *  KLOOP+1 
LAST  *  LAST-1 
GO  TO  70 
END  IF 

IF  (.NOT.  FLPHD)  GO  TO  1299 


. . .  SCORE  PULSE-HEIGHT  DISTRIBUTION 


EABST  =  CZERO 
DO  100  LS=LPHDB , LPHDE 

EABST  =  EABST+ PHDD ( LS ) 

PHDD(LS)  =  CZERO 
DO  110  JS=1, JSMAX 

IF ( SMARK ( JS )  .LE.  EABST)  GO  TO  120 
CONTINUE 
NPHD  =  NPHD+1 
GO  TO  1299 

ABE ( JS)  =  ABE ( JS) +CWCF 
IF (NINDV . EQ . 0 ) GO  TO  130 
DO  1298  NIND=1, NINDV 

EDTL  (NIND)  =EDPR  (NIND)  +EDNK  (NIND)  +EDSC  (NIND) 

CONTINUE 

WRITE  (44)  (EDPR(NIND)  ,  EDNK(NIND)  ,EDSC(NIND)  ,  EDTL  (NIND)  ,  NIND 


100 


110 


120 

1299 


1298 


HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 


00271 

00272 

00273 

00274 

00275 

00276 

00277 

00278 

00279 

00280 

00281 

00283 

00284 

00285 

00286 

00287 

00288 

00289 

00291 

00292 

00294 

00295 

00296 

00297 

00298 

00299 

00300 

00301 

00302 

00303 

00304 

00305 

00306 

00307 

00308 

00309 

00310 

00311 

00312 


New 
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$  =1,  NINDV) 

130  CONTINUE 

HIST 

00313 

c 

HIST 

00314 

CALL  RANSAV { IRC ) 

HIST 

00315 

c 

HIST 

00316 

RETURN 

HIST 

00317 

END 

HIST 

00318 
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SUBROUTINE  SRCINF (IMXOLD) 

SRCINF 

00002 

c  ************************************************** tt*t**t***tt*t**t***SRCmF 

00003 

c 

SRCINF 

00004 

c 

PROGRAM  SRCINF  IS  CALLED  BY 

SRCINF 

00005 

c 

INPUT 

SRCINF 

00006 

c 

PROGRAM  INPUT  CALLS 

SRCINF 

00007 

c 

INTRINSIC  FUNCTIONS 

SRCINF 

00008 

c 

MAX,  SIN,  COS,  SQRT 

SRCINF 

00009 

c 

EXTERNAL  FUNCTIONS 

SRCINF 

00010 

c 

ABORTX 

SRCINF 

00011 

c 

SRCINF 

00012 

c 

ORIGINATION  DATE  28  NOV  89 

SRCINF 

00013 

c 

LAST  MODIFIED  11  MARCH  91 

SRCINF 

00014 

c 

SRCINF 

00015 

c 

FUNCTION 

SRCINF 

00016 

c 

This  Subroutine  processes  the  SOURCE  Information 

SRCINF 

00017 

c 

SRCINF 

00018 

c 

INPUT  PARAMETERS 

SRCINF 

00019 

c 

IMXOLD  - 

SRCINF 

00020 

c 

SRCINF 

00021 

c 

OUTPUT  PARAMETERS 

SRCINF 

00022 

c 

NONE 

SRCINF 

00023 

c 

SRCINF 

00024 

C  ********** ***************** *******************************************gRCINp 

00025 

c  *** 

COMMON  BLOCKS  CNSTNT,  PARAMS,  OUT,  CALC,  STTS 

SRCINF 

00026 

C$ 

LIST (S=0) 

SRCINF 

00027 

CDIR$ 

NOLIST 

SRCINF 

00028 

IMPLICIT  DOUBLE  PRECISION  (A-H.O-Z) 

CNSTNT 

00081 

No  changes  in  CNSTNT  common  block  -  listing,  omitted  for  brevity,  is  identical  to 
that  given  in  Reference  1. 

CNSTNT  00082 

C  PARAMS  00002 

C  PARAMS  00003 

C  PARAMS  00004 

PARAMS  common  block  identical  to  that  shown  in  subroutine  INPUT 


C  .  . 


C 


I/O  UNIT  DECLARATIONS  AND  ARRAY  BUFFERS  PARAMS  00005 

PARAMETER  (I  IN  *  5,  I  OUT  «=  6,  ITP10  =  10,  ITP11  =  11,  ITP12  =  12,  PARAMS  00006 
$  ITP14  =  14,  MAX KEY  =  36) 


COMMON  /EXTSORC/  IRECTS , IDISKS , XLOWS , XHIGHS , YLOWS , YHIGHS , ZLOWS, 
$  ZHIGHS , XCENT , YCENT , ZCENT , XCIR , YCIR , ZCIR , KPERPYZ , KPREPXZ , KPERPXY 
LOGICAL  RRKILL,  FLMTEL 
COMMON  /OUT/ 

1  FLMTEL (INGP) 


PARAMS 

00008 

OUT 

00002 

New 
|  Code 

OUT 

00003 

v -  J 

OUT 

00004 

OUT  00005 


No  changes  in  OUT  common  block  -  listing,  omitted  for  brevity,  is  identical  to  that 
given  in  Reference  1. 


CALC  00002 

COMMON  /CALC /  CALC  00003 

lACON(INMT),  ASTEP ( INMAX ,  INMT)  ,  AT (NSURV,  INMT)  ,  CALC  00004 


No  changes  in  CALC  common  block  -  listing,  omitted  for  brevity,  is  identical  to 
that  given  in  Reference  1 . 


C 

LOGICAL  DMPFLG ,  FLMC 
DOUBLE  PRECISION  IRSAV 

COMMON  / STTS/  IB,  NB,  NSORS,  IBT,  BOLD,  BATCH, 
$  ,  IHIST,  IRSAV,  KPUT,  FLMC 
C 

C$  LIST (S=l) 

CDIR$  LIST 
C 

WRITE (IOUT,  *  (*  »i************************i • j 
$  • '  *  SOURCE  INFORMATION  * * • / 

$  i»  ************************ t t ) 

C 


CALC  00139 

STTS  00002 

STTS  00010 

KPUTMX,  DMPFLG  STTS  00017 

STTS  00018 

STTS  00019 

SRC  INF  00034 

SRCINF  0003  5 

SRCINF  00036 

SRCINF  00037 

SRCINF  00038 

SRCINF  0003  9 

SRCINF  0004  0 
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c 


c 


c 

c 


c 

c 

c 


c 

c 


IF  (FLESRC)  THEN 

WRITE (IOUT,  ■  ( ' ' OSOURCE  ELECTRONS  "  )  ' ) 

ELSE 

WRITE ( IOUT , ' ( 1 ' OSOURCE  PHOTONS ’ ' ) ' ) 

END  IF 

WRITE ( IOUT #  » ( 1  'OTHE  MAXIMUM  SOURCE  ENERGY  IS  "  , T38 , F12 . 5 , 

$  *  *  MEV’ ')  *)  TIN 

WRITE (IOUT, ’( 1 'OTHE  GLOBAL  ELECTRON  CUTOFF  ENERGY  IS ' 1 # T38 , F12 . 5 , 
$  1 1  MEV* ') ’)  TCUT 

WRITE (IOUT,  '(' 'OTHE  PHOTON  CUTOFF  ENERGY  IS  1 1 , T38 , F12 . 5, 

$  ' 1  MEV' ') ’ )  TPCUT 

IF  (TSAVE  .GT.  TCUT)  WRITE { IOUT , 1 ( 1 1 OTHE  GLOBAL  ELECTRON  TRAP", 

$  "PING  ENERGY  IS' *  ,T38,F12. 5,  '  1  MEV")')  TSAVE 

IF  (FLSPEC)  THEN 

WRITE {IOUT, * (  "  OSOURCE  SPECTRUM’  * )  ' ) 

WRITE {IOUT, * (1216) ’ )  JSPEC 

WRITE {IOUT, 1 (  "  ONORMALIZED  CUMULATIVE  SPECTRUM*  * )  ’ ) 

WRITE(IOUT, ' (6F12.5) ')  (SPECIN(J) ,J=1, JSPEC) 

IF  ( (SPECIN { 1)  .NE.  CONE)  .OR.  (SPECIN (JSPEC)  .NE.  CZERO) )  THEN 
WRITE  (IOUT,*)  *  INPUT  CUMULATIVE  SOURCE  SPECTRUM  MUST  BE', 

$  '  MONOTONICALLY  DECREASING  FROM  1.0  TO  0.0' 


CALL  ABORTX ( ' SRCINF ' ) 


END  IF 

WRITE  { IOUT,  '(  "OSPECTRAL  ENERGIES  (MEV)")') 
WRITE(IOUT, ' (6F12.5) ' )  (ESP(J) ,J=1, JSPEC) 

END  IF 


SRCINF 

SRCINF 

SRCINF 
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SRCINF 

SRCINF 
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SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 
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SRCINF 
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SRCINF 

SRCINF 

SRCINF 

SRCINF 
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SRCINF 

SRCINF 
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00045 

00046 

00047 

00048 

00049 

00050 

00051 

00052 

00053 

00054 

00055 

00056 

00057 

00058 

00059 

00060 

00061 

00062 

00063 

00064 

00065 

00066 

00067 

00068 

00069 

00070 

00071 


IF ( IRECTS . EQ . 0  .AND.  IDISKS.EQ.O)  THEN 

WRITE (IOUT, ' (' ' OCOORDINATES  OF  THE  POINT  SOURCE  OR  OF  THE' ', 

$  "  CENTER  OF  THE  BEAM  (DISK)  SOURCE  ARE"/ 

$  "  X  =  ",E12.5,"  CM'  '  ,  10X,  "  Y  =  ",E12.5, 

$  *'  CM",10X,"Z  -  ",E12.5,"  CM")') 

$  XSR,  YSR,  ZSR 

WRITE  ( IOUT,  ’  ("OTHE  RADIUS  OF  THE  BEAM  (DISK)  SOURCE  IS  =  ", 
$  1PE12.4,"  CM")')  SORCIN 
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SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 


END  IF 
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00085 
00086 
00087 
00088 
00089 
00095 
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WRITE (IOUT,  ' (  "  0 REFERENCE  DIRECTION 

FOR  ANGULAR  DISTRIBUTION* ' , 

SRCINF 

00090 

$ 

'  '  IS  DEFINED  BY'  '/" 

THETA  =  ' ' ,G11.4, 

SRCINF 

00091  1 

L 

$ 

"  DEGREES"  ,10X,  "PHI 

=  '  '  ,  Gil .  4 ,  "  DEGREES")') 

SRCINF 

00092 

$ 

CTSR,  CPSR 

SRCINF 

00093 

TEMPA 

- 

CTSR/C180PI 

SRCINF 

00096 

CTSR 

= 

COS (TEMPA) 

SRCINF 

00097 

STSR 

— 

SIN  (TEMPA) 

SRCINF 

00099 

TEMPA 

= 

CPSR/C180PI 

SRCINF 

00100 

CPSR 

= 

COS (TEMPA) 

SRCINF 

00101 

SPSR 

- 

SIN  (TEMPA) 

SRCINF 

00102 

New 

Code 


IF ( IRECTS . EQ . 1 ) THEN 

WRITE ( IOUT , 55 ) XLOWS , XHIGHS , YLOWS , YHIGHS , ZLOWS , ZHIGHS 
FORMAT (//IX, 'RECTANGULAR  PLATE  SOURCE ,'/ 5X ,' BOUNDING  COORDINATES  A 
$RE  -  ' /10X, *XLOW  =  ' , E12 . 5, 1  XHIGH  =  ' , E12 . 5/10X, ' YLOW  =  ' , E12 . 5 
$,*  YHIGH  -  ' ,E12.5/10X, 'ZLOW  =  ',E12.5,'  ZHIGH  =  ’,E12.5) 

IF (ABS (XHIGHS -XLOWS) . LE . CT1EM7 ) KPERPYZ=1 
IF (ABS (YHIGHS -YLOWS ) . LE . CT1EM7 ) KPERPXZ-1 
IF (ABS { ZHIGHS - ZLOWS ) . LE . CT1EM7 ) KPERPXY= 1 
KPRPSUM=KPERPYZ+KPERPXZ+KPERPXY 
IF (KPRPSUM . EQ . 0  .OR.  KPRPSUM . EQ . 3 ) THEN 
WRITE (IOUT, 54) 

FORMAT (///IX, 'PROBLEM  IN  DEFINITION  OF  SOURCE  PLANE  ORIENTATION') 
CALL  ABORTX  ('SRCINF') 

END  IF 
END  IF 
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IF ( IDISKS . EQ . 1 ) THEN 

WRITE ( I OUT r  56) XCENT , YCENT , ZCENT , XCIR , YCIR , ZCIR 
FORMAT  ( / /IX ,  1  CIRCULAR  DISK  SOURCE » /5X ,  '  COORDINATES  OF  CENTER  ARE1/ 
$10X,  •  XCENTER  «=  *  ,  E12 . 5  ,  •  Y CENTER  =  \E12.5,'  ZCENTER  =  »,E12.5 

$//5X,  'COORDINATES  OF  POINT  ON  CIRCUMFERENCE  ARE  * /10X,  ' XCIR  =  ’, 
$E12 .  5 ,  '  YCIR  =  ’,E12.5,»  ZCIR=  *,E12.5) 

IF { ABS (XCENT-XCIR) . LE . CT1EM7 ) KPERPYZ=1 
IF (ABS (YCENT -YCIR) . LE . CT1EM7 ) KPERPXZ=1 
IF (ABS (ZCENT- ZCIR) . LE . CT1EM7 ) KPERPXY= 1 
KPRPSUM^KPERPYZ+KPERPXZ+KPERPXY 
IF (KPRPSUM . EQ . 0  .OR.  KPRPSUM . EQ . 3 ) THEN 
WRITE (IOUT, 54) 

CALL  ABORTX ( 1 SRCINF • ) 

END  IF 


IF ( SORCIN . EQ . CZERO ) THEN 


WRITE ( IOUT , 57 ) 

CALL  ABORTX ( ’ SRCINF ’ ) 


RSSQQ=SQRT(  (XCENT-XCIR)  *  +  2  +  (YCENT-YCIR)  **2  +  (ZCENT-ZCIR)  **2) 
IF (ABS (RSSQQ- SORCIN) . GT . CT1EM7 ) THEN 


WRITE { IOUT , 58 ) 

CALL  ABORTX (' SRCINF ' ) 


New 

Code 


SORCIN=RSSQQ 
WRITE (IOUT, 59) SORCIN 

FORMAT (/IX, 'RADIUS  OF  THE  DISK  SOURCE  IS  ',E12.5) 

END  IF 

FORMAT {///IX, 'SOURCE  DISK  RADIUS  NOT  SPECIFIED') 

FORMAT  (///IX,  'SOURCE  DISK  RADIUS  INCONSISTENT  WITH  SPECIFICATION  O 
$F  POINTS  ON  CIRCUMFERENCE  AND  AT  CENTER  OF  SOURCE  DISK') 


This  code  block  checks  to  see  if  the  sine  of  the  input  polar 
angle  direction  is  less  than  zero.  If  it  is,  it  allows  this 
condition  within  an  acceptable  tolerance  and  changes  the  sine 
of  the  angle  to  zero;  else  it  aborts. 

IF  (STSR  .LT.  CZERO)  THEN 
IF  (STSR  .GT.  -C1EM6)  THEN 

WRITE  (IOUT,  '(//,'  '  >>>>  SRCINF:  WARNING!  SINE  OF  SOURCE'', 

$  1  *  INPUT  POLAR  ANGLE  DIRECTION  IS  CHANGED  TO  ZERO. ' ') 

STSR  «=  CZERO 
CTSR  *  SIGN  (CONE,  CTSR) 

ELSE 

WRITE  (IOUT,  *  (//,  11  >>>>  THE  INPUT  POLAR  ANGLE  WITH  THE' 

$  "  DIRECTION  KEYWORD  MUST  BE  BETWEEN  ZERO  AND  180'' 

$  ' ’  DEGREES .  "  )  ' ) 

^ALL  ABORTX  (' SRCINF  ' ) 


END  IF 
END  IF 
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' ) SRCINF 
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00119 

00120 
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ono  ono  o  o  o  o  o  o  o  o  o  non  no 


c 


c 

c 


c 


c 


IF ( IRECTS . EQ . 0  .AND.  IDISKS.EQ.O)  THEN 
WSRX  =  STSR*CPSR 
WSRY  =  STSR*SPSR 
WSRZ  =  CTSR 


.  USUALLY  W1(V)  «  R  (V)  X  OMEGA  (V) 


W1X  =  YSR*WSRZ  -  ZSR*WSRY 

W1Y  =  ZSR*WSRX  -  XSR*WSRZ 

W1Z  =  XSR*WSRY  -  YSR*WSRX 

XNRM  =  W1X*W1X  +  W1Y*W1Y  +  W1Z*W1Z 


.  UNLESS  R  (V)  X  OMEGA  (V)  =  0 


IF  (XNRM  .EQ.  CZERO)  THEN 


IF  I(V)  *  OMEGA  (V)  =  0,  W1  (V)  =  I  (V) 


IF  (WSRX  .EQ.  CZERO)  THEN 
W1X  =  CONE 
W1Y  =  CZERO 
W1Z  =  CZERO 


IF  J(V)  *  OMEGA (V)  =  0,  W1 (V)  =  J(V) 


ELSE  IF  (WSRY  .EQ.  CZERO)  THEN 
W1X  =  CZERO 
W1Y  =  CONE 
W1Z  =  CZERO 


IF  K(V)  *  OMEGA (V)  *  0,  W1  (V)  -  K(V) 


ELSE  IF  (WSRZ  .EQ.  CZERO)  THEN 
W1X  =  CZERO 
W1Y  =  CZERO 
W1Z  =  CONE 


OTHERWISE,  W1(V)  =  +OR-  K(V)  X  OMEGA (V) 


ELSE 

W1Z  =  CZERO 

W1X  =  CONE/ SQRT( CONE  +  (WSRX/WSRY) **2 ) 
W1Y  =  -W1X* WSRX/ WSRY 
END  IF 
ELSE 

XNRM  =  SQRT(XNRM) 

W1X  =  W1X/XNRM 
W1Y  =  W1Y/XNRM 
W1Z  =  WIZ/XNRM 
END  IF 

W2X  =  WSRY*W1Z  -  WSRZ*W1Y 
W2Y  =  WSRZ*W1X  -  WSRX*W1Z 
W2Z  =  WSRX*W1Y  -  WSRY*W1X 
XSR  =  XSR  +  CT1EM7  * WSRX 
YSR  =  YSR  +  CT1EM7  *WSRY 
ZSR  =  ZSR  +  CT1EM7  *WSRZ 
IF  (SORCIN  .EQ.  CZERO)  THEN 
XSR  =  XSR+CT1EM7*W1X 
YSR  *  YSR+  CT1EM7  *W1Y 
ZSR  =  ZSR+CT1EM7*W1Z 
END  IF 
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00183 
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END  IF 

IF  (ICTH  .EQ.  1)  THEN 

WRITE (IOUT,  '  ( * ' OMONODIRECTIONAL  SOURCE  IN  REFERENCE ? 1 , 

$  ' '  DIRECTION'1)') 

ELSE  IF  (ICTH  .EQ.  2)  THEN 

WRITE  (IOUT,  ■  (  •  1  0 ISOTROPIC  SOURCE  TRUNCATED  AT  *  '  ,G11.4, 

$  1  *  DEGREES  WITH  RESPECT  TO  REFERENCE  DIRECTION'  ')  ') 

CTHIN  =  COS ( CTHIN/ C18  0PI ) 

ELSE 

WRITE (IOUT, ’ ( ' ' 0 CO SINE -LAW  SOURCE  TRUNCATED  AT  ",G11.4, 

$  » »  DEGREES  WITH  RESPECT  TO  REFERENCE  DIRECTION* ' ) ' ) 

CTHIN  =  COS (CTHIN/C180PI) **2 
END  IF 

IF  (NB  .LE.  0)  NB  =  10 

IF  (IMAX  .LT.  NB)  IMAX  =  NB 
IMAX  =  IMAX/NB 
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non 


c 

c 

c 


c 

c 

c 


IF  ( (IBT  .NE.  0)  .AND.  (IMAX  .NE.  IMXOLD})  THEN 

•  .  .  BATCH  SIZES  INCONSISTENT  ON  RESTART  -  TERMINATE  RUN 

WRITE ( I OUT , • (' '0***  FATAL  ERROR  ON  ATTEMPTED  RESTART  **** */ 

$  1 1  NEW  BATCH  SIZE  *  • *,110,  '  *  DOES NT  EQUAL  OLD  BATCH  SIZE  =  *  * 

$  110/**  BATCH  SIZES  MUST  MATCH  TO  CORRECTLY  ACCUMULATE *» , 

$  * *  STATISTICS* *  )')  IMAX,  IMXOLD 

CALL  ABORTX l 1 SRCINF  * ) 


END  IF 

NB  =  NB  +  IBT 

WRITE ( IOUT, *(» *0THE  STANDARD  ERROR  ESTIMATES  ARE  BASED  ON  * ' , 15 
$  *’  BATCHES  OF  *»,I7,**  HISTORIES  EACH’*)*)  NB, IMAX 

RETURN 

END 
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SUBROUTINE  KEYMAP  ( INDX ,  FLDUP ) 

Q  **********+★*********★************★********************************** 

C 

SUBROUTINE  KEYMAP  IS  CALLED  BY 

INPUT 

SUBROUTINE  KEYMAP  CALLS 
INTRINSIC  FUNCTIONS 


EXTERNAL  FUNCTIONS 


ORIGINATION  DATE 
LAST  MODIFIED 


15  AUG  90 
11  MARCH  91 


FUNCTION 

This  subroutine  contains  the  INPUT  Primary  Keyword  mapping. 
It  takes  the  "indx"  of  the  keyword  list  array  as  input  and 
returns  the  status  of  the  duplicate  keyword  flag,  "fldup". 

INPUT  PARAMETERS 

INDX  -  Index  of  the  keyword  list  array 
OUTPUT  PARAMETERS 

FLDUP  -  Status  of  the  duplicate  keyword  flag 
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C  ************************************  ****** hint************ ************* 

C  ***  COMMON  BLOCKS  CNSTNT,  PARAMS 
C$  LIST (S=0 ) 

CDIR$  NOLIST 

IMPLICIT  DOUBLE  PRECISION  (A-H,0-Z) 

No  changes  in  CNSTNT  common  block  -  listing,  omitted  for  brevity,  is  identical  to 
that  given  in  Reference  1. 

CNSTNT  00082 

C  PARAMS  00002 

C - PARAMS  00003 

C  PARAMS  00004 

PARAMS  common  block  identical  to  that  shown  in  subroutine  INPUT 


C$ 

CDIR$ 

C 


C 

c 


LIST (S=l) 

LIST 

CHARACTER* 17  OKEYLS (MAX KEY) 
LOGICAL  FLDUP 


DATA  OKEYLS  / ' BATCHES ' , 
•DIRECTION 


•CUTOFFS' , 

,  'DUMP',  'ECHO*, 

• ELECTRONS ' ,  ' ELECTRON- ESCAPE • ,  ' ELECTRON-FLUX 1 , 

•ENERGY',  ’GEOMETRY',  'HISTORIES',  'NEW-DATA-SET • , 
•NEXT-EVENT-ESCAPE* ,  'NO-KNOCKONS '  ,  'NO -STRAGGLING' , 
' PHOTONS ’ ,  *  PHOTON-ESCAPE ' ,  '  PHOTON-FLUX ' ,  ' PLOTS ' , 

» POSITION ' ,  ' PRINT -ALL ' ,  *  PULSE-HEIGHT ' , 

'  RANDOM -NUMBER  *  ,  'RESTART',  '  SCALE -BREMS '  , 

•  SCALE-IMPACT  * ,  ' SIMPLE-BREMS ' ,  ' SPECTRUM ' ,  ' TITLE ’ , 
•TRAP-ELECTRONS' ,  'NO-COHERENT' ,  ' NO -INCOH- BINDING ’ , 

•DETAIL- IONIZE ' / 

•DETAIL -IONIZE’ , ' RECTANGLE - SOURCE ' , ' CIRCLE -SOURCE ' , 

• INDIVIDUAL-HISTS ’ / 

Print  that  the  keyword  pointed  to  by  INDX  is  a  duplicate  entry 


WRITE  (IOUT,  '('  *  »»  KEYMAP:  DUPLICATE  INPUT  KEYWORD: 
$  OKEYLS (INDX) 

IF  (.NOT.  FLDUP)  FLDUP  *  .TRUE. 

RETURN 

END 


(A)  )  ' ) 


KEYMAP 

00034 

KEYMAP 

00035 

KEYMAP 

00036 

KEYMAP 

00037 

KEYMAP 

00038 

KEYMAP 

00039 

KEYMAP 

00040 

KEYMAP 

00041 

KEYMAP 

00042 

KEYMAP 

00043 

KEYMAP 

00044 

KEYMAP 

00045 

KEYMAP 

00046 

KEYMAP 

00047 

KEYMAP 

00048 

KEYMAP 

00049 

KEYMAP 

00050 

_ r 

KEYMAP 

0(50511 

KEYMAP 

00052 

KEYMAP 

00053 

KEYMAP 

00054 

KEYMAP 

00055 

KEYMAP 

00056 

KEYMAP 

00057 

KEYMAP 

00058 

KEYMAP 

00059 

New 

Code 
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Appendix  3 

count.F  Program  Listing 


parameter  (maxhis  =  10000) 
parameter  (mxclls  -  2) 

dimension  edep(200) , nelec(200) ,nprot (200) #nneut (200) ,nphot (200) 
l,edelec (200) , edprot(200) , edphot (200) ,edneut (200) , iesc(10) , 

2numcoin(3)  , koine  (3  , mxclls)  , kcell (mxclls) 
dimension  nhcoin (maxhis, 3) ,npart (3) 
data  npart/9,1,2/ 
data  kcell/67,88/ 
data  eps/l.e-8/ 

data  nt ime , nw8 win , ncl imp , nwcut , nh , iesc , numcoin/ 18*0/ 
data  eesc,elostot/0.0, 0.0/ 

data  edeptot , eprtot , ephtot , edntot , edeltot / 5*0./ 
data  edep , edprot , edphot , edelec , edneut/1000* 0 . / 
data  nelec , nprot , nneut , nphot / 8  0  0  *  0 / 

open(l,file=' trkbin* , status =* unknown* , f orm= ' UNFORMATTED  * ) 
open (7 , f ile=  *  countups  * , s tat us =* unknown* ) 
print  77 
read ( 5 , * ) nmax 

77  format (lx, *  Enter  number  of  histories*) 

111  format (lx, ‘problem  in  track  file*) 
c  start  a  history 

do  18  i=l,3 
do  18  k=l, mxclls 
18  koine (i,k)=0 

20  nh=nh+l 

lflag=0 

elost=0.0 

if (nh.gt .nmax) go  to  2000 
read { 1 , end=2  000) nhs t ry , ns tart 

read ( 1 ) nevent , nsrc , ipt , ncell , mat , xs , ys , zs , us , vs , ws , es , wt , time 
do  25  nc=l, mxclls 
do  25  i=l , 3 
np=npart (i) 

25  if (ipt. eg. np  .and.  ncell. eq. kcell (nc) )  koine (i,nc) =koinc (i,nc) +1 
ec=es 

iptold=ipt 

ncold-ncell 

oldtim=time 

c  read  event  records 

1000  read (1) nevent, nsurf , il, ipt, ncell, mat, x,y, z,u,v,w,e,wt, time 
do  26  nc=l, mxclls 
do  26  i=l , 3 
np=npart (i) 

26  if(ipt.eq.np  .and.  ncell .eq. kcell (nc) )  koine (i,nc) =koinc  (i,nc) +1 
if (il .eq. 0 .and. If lag. gt . 0) elost=elost-e*wt 

nter=0 

de=ec-e 

dt=time-oldtim 
if (nevent .eq. 9000) then 
nter=nsurf 
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nbmch=il 

if  (nter . eq . 1 ) then 
iesc (ipt) =iesc (ipt) +1 
eesc=eesc+e*wt/nmax 

go  to  20 
end  if 

if (nter.gt .2) then 
if (nter.eq.3)ntime=ntime+l 
if (nter .eq.4) nw8win=nw8win+l 
if (nter . eq. 5) nclimp=nclimp+l 
if (nter . eq. 6) nwcut=nwcut+l 
end  if 
end  if 

if (nevent .ge . 2000 .  and.  nevent . It .3000) then 
nter=nsurf 

if (nter . gt . 12 . and . nter . It . 15 ) then 
If lag=lflag+l 
elost=elost+e 
end  if 

if (nter. eq.l) then 

iesc (ipt) =  iesc (ipt) +1 

eesc=eesc+e*wt/nmax 

go  to  19 

end  if 

end  if 

if (nter . eq. 2 ) de=ec-e 

if (ipt .eq.iptold  .and.  dt.ge.eps.and.de.ge.eps) then 
c  energy  deposition  by  charged  particle  CSDA  or  neutral  particle 
c  inelastic  collision 

edep (ncold) =edep (ncold) +de*wt 
c  electron 

if (ipt.eq.3) then 

nelec (ncold) =nelec (ncold) +1 
edelec (ncold) =edelec (ncold) +de*wt 
end  if 

c  proton 

if (ipt .eq. 9) then 

nprot (ncold) =nprot (ncold) +1 
edprot (ncold) =edprot (ncold) +de*wt 
end  if 

c  neutron 

if (ipt .eq. 1) then 

nneut (ncold) =nneut (ncold) +1 
edneut (ncold) =edneut (ncold) +de*wt 
end  if 

c  photon 

if (ipt. eq. 2) then 

nphot (ncold) =nphot (ncold)  +1 
edphot (ncold) -edphot (ncold) +de*wt 
end  if 

end  if 

19  iptold=ipt 
ec=e 

oldtim=time 

ncold=ncell 

if (nevent. eq. 9000) then 
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elostot=elostot+elost 
do  220  k=l , 3 
do  219  nc=l,mxclls 

219  if (koinc(k,nc) .eq.0)go  to  220 

numcoin (k) =numcoin (k) +1 

ll=numcoin(k) 

nhcoin { 11 ,  k) =nh 

220  continue 

do  221  k=l,3 
do  221  nc=l,mxclls 

221  koine (k#nc) =0 

go  to  20 
end  if 
go  to  1000 

2000  continue 

elostot=elostot/nmax 
do  2100  m=l ,200 
edep  (m)  =edep  (m)  /nmax 
edprot  (m)  =edprot  (m)  /nmax 
edphot  (m)  =edphot  (m)  /nmax 
edneut  (m)  = edneut  (m)  /nmax 
edelec  (m)  =edelec  (m)  /nmax 
edeptot=edeptot+edep  (m) 
eprtot=eprtot+edprot (m) 
ephtot=ephtot+edphot  (m) 
edntot=edntot+ edneut (m) 
edeltot=edeltot+edelec (m) 

2100  write (7, 112 )m, edep (m)  /nprot(m)  , edprot (m)  ,nelec(m)  #  edelec  (m) 
lnneut  (m)  ,  edneut  (m)  ,  nphot  (m)  ,  edphot  (m) 
edeptot=edeptot+elostot 
write (7, 119) (iesc(i) ,i=l,10) ,eesc 

write (7,114) edeptot , eprtot , ephtot , edntot , edeltot , elostot , 
$numcoin  ( 1 )  ,  numcoin  ( 2 )  ,  numcoin  ( 3 ) 
do  3  00  k=l ,  3 
maxk=numcoin  (k) 
if (k.eq.l) write (7, 302) 
if (k.eq.2)write(7,303) 
if (k.eq. 3) write (7, 304) 
write (7, 301) (nhcoin (m,k) ,m=l,maxk) 

300  continue 

301  format (15i8) 

302  format (/lx, 'history  numbers  for  proton  coincidence  events') 

303  format (/lx, 'history  numbers  for  neutron  coincidence  events') 

304  format  (/lx, 'history  numbers  for  photon  coincidence  events') 

114  format (lx, ' total  energy  deposited  =  ' , el2 . 5/l0x, ' f rom  protons  =  ', 
xel2 .5, /I0x, 'from  photons  =  el2 . 5/lOx, ' from  neutrons  =  ',el2.5/ 
xlOx, 'from  electrons  =  ' , el2 . 5 , /lOx, ' f rom  inelastic  collisions^' 
$,el2.5/l0x, 'number  of  proton  coincidence  events  =',i5 
$/l0x, 'number  of  neutron  coincidence  events  =',i5 
$/l0x, 'number  of  photon  coincidence  events  =',i5) 

119  format (lx, 'no.  of  escaped  particles  =',10i6,/lx, 

$'  escaped  energy  =',el2.5) 

112  format  (lx,  i5 ,  el2 .5,4  (il5,  el2 . 5)  ) 
stop 
end 
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in  i>  u> 


Appendix  4 


source.F  Program  Listing  for  MCNPX  Beam  Source 

Allowing  for 

User-supplied  Location,  Direction,  Energy,  Particle  Specie 


c_deck  so  source 
1 

subroutine  source 

2 

c  user  supplied  source  subroutine 
#include  "cm.h" 
c 

data  issty/0/ 

if (issty .eq. 0) then 

wgt=l . 0 

tme=0 . 0 

write (jtty, 1) 

read (itty, *) xxx, yyy, zzz 

write (jtty, 2) 

read  (itty,  *)uuu,vw,www 

aa=sqrt  (uuu**2+vw**2+www**2) 

uuu=uuu/aa 

wv=vw/aa 

www=www/aa 

write (jtty, 7) 

read (itty, *) ipt 

write (jtty, 3) 

read (itty, *) erg 

write (jtty, 4) 

read ( itty , *)isu 

write (jtty, 5) 

read (itty, *) icl 

write  (47)  wgt ,  tme, xxx, yyy,  zzz , uuu,  vw, www#  erg,  ipt,  jsu,  icl 
print  6, xxx, yyy,  zzz, uuu, vw,www,  icl,  jsu,  ipt, erg, wgt,  tme 
write(iuo,8) 

write  (iuo,  6) xxx, yyy,  zzz, uuu,  vw,www,  icl,  j  su,  ipt , erg ,  wgt ,  tme 

write(iuo,9) 

issty=l 

else 

rewind  47 

read(47)  wgt,  tme, xxx, yyy,  zzz, uuu,  vw, www, erg,  ipt,  jsu,  icl 
do  50  ispr=l,3 
50  spare (ispr) =0.0 
end  if 

1  format (lx, 1 Enter  the  source  point  (x,y,  z)') 

2  format (lx, 'Enter  the  source  beam  direction  cosines  (u,v,w)') 

3  format (lx, 'Enter  the  source  energy  (MeV) 1 ) 

4  format (lx, ' If  this  is  a  surface  source,  enter  surface  number'/ 

$lx,  'if  not,  enter  O') 

format (lx, 'Enter  the  cell  number  containing  the  source  point') 
format (lx, 'Enter  particle  type  (ipt) ') 

format (lx, 'User- supplied  source ' /lx, 'xxx  =  ',el2.5,'  yyy  =  ',el2.5 
$,  '  zzz  =  ' ,el2 . 5/lx, 'uuu  =  ',el2.5,'  vw  =  ',el2.5,'  www  =  *,el2.5 
$/lx, 'icl  =  ' , i5 ,  '  jsu  =  ' , i5 , '  ipt  =  ',i5/lx,'erg  =  ',el2.5, 

$'  wgt  =  ' ,el2 .5, '  time  =  »,el2.5) 

8  format (/////lx, *  ****************************************** i # 


9  format ( / 

$ 

$ 

return 

end 

13 


lx  ,******************************************,t 
lx, • ****************************************** * /) 
lx,  1  ******************************************  1 
lx, '******************************************' 
lx, • ******************************************* /////) 


so 

so 


so 
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Appendix  5 

ITS-ACCEPT  Input  File  for  the  CEASE-DD1  Dosimeter 


10  MEV  DOME  SOURCE  FIAT  DOSIMETER  TEST  -DD1 
**********************  GEOMETRY  *********************** 
GEOMETRY 
*1 


RCC 

o 

o 

o 

o 

-0.2032 

o 

o 

0.00000 

0.2032 

1.75514 

*2 

RCC 

0.0 

0.0 

-0.36068 

0.0 

.00000 

0.15748 

1.75514 

*3 

RCC 

0.0 

0.0 

-0.36158 

0.0 

.00000 

0.00090 

1.75514 

*4 

RCC 

0.0 

0.0 

-0.38158 

0.0 

.00000 

0.02000 

1.75514 

*5 

RCC 

0.0 

0.0 

-0.45158 

0.0 

.00000 

0.07000 

1.75514 

*6 

RCC 

0.0 

0.0 

-0.55158 

0.0 

.00000 

0.10000 

1.75514 

*7 

RCC 

0.0 

0.0 

-0.70400 

0.0 

.00000 

0.15242 

1.75514 

*8 

RCC 

0.0 

0.0 

-1.20400 

0.0 

.00000 

0.50000 

1.75514 

*9 

RCC 

0.0 

0.0 

-0.2032 

0.0 

0.00000 

0.2032 

1.76 

*10 

RCC 

0.0 

0.0 

-0.36068 

0.0 

.00000 

0.15748 

1.76 

*11 

RCC 

0.0 

0.0 

-0.36158 

0.0 

.00000 

0.00090 

1.76 

*12 

RCC 

0.0 

0.0 

-0.38158 

0.0 

.00000 

0.02000 

1.76 

*13 

RCC 

0.0 

0.0 

-0.45158 

0.0 

.00000 

0.07000 

1.76 

*14 

RCC 

0.0 

0.0 

-0.55158 

0.0 

.00000 

0.10000 

1.76 

*15 

RCC 

0.0 

0.0 

-0.70400 

0.0 

.00000 

0.15242 

1.76 

*16 

RCC 

0.0 

0.0 

-1.20400 

0.0 

.00000 

0.50000 

1.76 

*17 

RPP 

1 

o 

00 

ui 

0.85 

in 

00 

o 

0.85 

-0.36158 

-.36068 

*18 


RPP 

-0.6477  0. 

6477 

-0.6477  0.6477  -0.38158 

-0.36158 

*19 

RPP 

i 

o 

00 

U1 

o 

00 

U1 

-0 

.85  0.85  -0.38158  -.36158 

*20 

RPP 

-0.45  0.45 

-0 

.45  0.45  -0.45158  -0.38158 

*21 

RPP 

-0.6477  0. 

6477 

-0.6477  0.6477  -0.45158 

-0.38158 

*22 

RPP 

-0.85  0.85 

i  -0 

.85  0.85  -0.45158  -0.38158 

*23 

RPP 

-0.6342  0. 

6342 

-0.6342  0.6342  -0.55158 

-0.45158 

*24 

RPP 

-0.6477  0. 

6477 

-0.6477  0.6477  -0.55158 

-0.45158 

*25 

RPP 

-0.85  0. 

85 

-0.85  0.85  -0.55158 

-0.45158 

*26 

RPP 

-0.6477  0. 

6477 

-0.6477  0.6477  -0.70400 

-0.55158 

*27 

RPP 

-0.85  0. 

85 

-0.85  0.85  -0.70400 

-0.55158 

*28 

SPH 

o 

o 

o 

o 

0.0 

1.75514 

*29 

SPH 

0.0  0.0 

0.0 

1.76 

*30 

RCC 

0.0  0.0 

0.0 

0.0  0.00000  1.76 

1.75514 

*31 

RCC 

0.0  0.0 

0.0 

0.0  0.00000  1.76 

1.76 

*32 

SPH 

0.0  0.0 

0.0 

5.0 

*33 

SPH 

0.0  0.0 

0.0 

10.0 
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END 


♦VOID 
Z01  +1 
Z02  +2 
Z03  +17 
Z04  +3  -17 
Z05  +11  -3  -17 
Z06  +18 
Z07  +19  -18 
Z08  +4  -19  -18 
Z09  +12  -4  -19  -18 
Z10  +20 
Zll  +21  -20 
Z12  +22  -21  -20 
Z13  +5  -22  -21  -20 

Z14  +13  -5  -22  -21  -20 

Z15  +23 
Z16  +24  -23 
Z17  +25  -24  -23 
Z18  +6  -25  -24  -23 
Z19  +14  -6  -25  -24  -23 
Z20  +26 
Z21  +27  -26 
Z22  +7  -27  -26 
Z23  +15  -7  -27  -26 
Z24  +8 

Z25  +16  -8 

Z26  +28  +30 

Z27  +29  +31  -28 

Z28  +30  -29 

Z29  +9  -1 

Z30  +10  -2 

Z31  +31  -1  -2  -3  -4  -5  -6  -7  -8  -9  -10  -11  -12  -13  -14 
-15  -16  -17  -18  -19  -20  -21  -22  -23  -24  -25  -26  -26 
-28  -29  -30 
Z32  +32  -31 

END 

♦MATERIAL 


1 

0 

1 

0 

0 

0 

1 

0 

0 

2 

0 

1 

0 

0 

3 

0 


Two  column 
format  used  here 
to  conserve  space 


i 

o 

0 

1 

1 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 


.6312 


**********************+  SOURCE  ******************** 

ELECTRONS 
SPECTRUM  11 

1.0000  .9553  .9062  .8559  .8046  .7508  .6932 

.5627  .4573  0.0 

10.0000  9.2000  9.1000  9.0000  8.9000  8.6000  8.3000  8.0000 

7.5000  5.0000  0.0 

**********************  OPTIONS  ******************* 

PULSE-HEIGHT  10  10 

NBINE  102 
DOME  -  SOURCE^L^ 

******  *******>*«^i^ 

HISTORIES  10000 


TfiiV  is  die  hemispherical  dome  source  option  as  depicted  in  Figure  15. 
For  the  flat  disc  source  option  depicted  in  Figure  14,  this  line  must  be 
replaced  with 

CIRCLE-SOURCE  0.  0.  -0.01  1.755  0.  -0.01 

RADIUS  1.755 

DIRECTION  180.0 
ISOTROPIC 
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Appendix  6 

MCNPX  Input  File  for  the  CEASE-DD2  Dosimeter 


CEASE  DD2  dosimeter  MCNPX#  electrons,  isotropic  source  on  hemispherical  void 
C  Cells 

C  Silicon  Dosimeter  DD2 

1  2  -2.33  23  -25  22  -24  6  -5 

C  Voids  surrounding  DD2 


2 

0  15  -17 

14  -16  6  -5 

#1 

3 

0  15  -17 

14  -16  7  -6 

#5 

4 

0  15  -17 

14  -16  6  5 

-4 

c 

Aluminum 

Oxide  substrate 

5 

3  -3.97 

19  -21  18  - 

20  7 

-6 

c 

Aluminum 

base 

6 

1  -2.7  15  -17  14  -16 

8  -7 

c 

Aluminum 

sides 

7 

1  -2.7 

11  -13  10  - 

14  8 

-4 

8 

1  -2.7 

11  -13  16  - 

12  8 

-4 

9 

1  -2.7 

11  -15  14  - 

16  8 

-4 

10 

1  -2.7 

17  -13  14  - 

16  8 

-4 

c 

Al  foil 

11 

1  -2.7 

11  -13  10  - 

12  4 

-3 

c 

void  cylinder  above 

foil 

12 

0  -26  3  -2 

c 

Al  cover  plate 

13 

1  -2.7 

2  -1  -26 

c  Void  cylinder  around  box 

14  08-3  -26  #1  #2  #3  #4  #5  #6  #7  #8  #9  #10  #11 

c  Void  cylinder  below  box 

15  09-8  -26 

c  Void  hemispherical  region  above  plate 

16  0  1  -27 

c  Hemispherical  void  region  enclosing  upper  half (dome) 

17  0  27  -28  1 

c  Spherical  void  region  enclosing  everything 

18  0  -29  #1  #2  #3  #4  #5  #6  #7  #8  #9  #10  #11  #12  #13  #14  #15  #16 

#17 

c  exterior  void  escape  region 

19  0  #18 

c  Surfaces 


1 

pz 

0.0 

2 

pz 

-0.635 

3 

pz 

-0.79248 

4 

pz 

-0.79338 

5 

pz 

-0.81338 

6 

pz 

-0.88338 

7 

pz 

-0.98338 

6 

pz 

-1.1358 

9 

pz 

-1.6358 

10 

py 

-0.85 

11 

px 

i 

o 

00 

U1 

12 

py 

0.85 

13 

px 

0.85 

14 

py 

-0.6477 

15 

px 

-0.6477 

16 

py 

0.6477 

17 

px 

0.6477 

18 

py 

-0.6342 

19 

px 

-0.6342 

20 

py 

0.6342 
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21 

px 

0.6342 

22 

py 

-0.45 

23 

px 

-0.45 

24 

py 

0.45 

25 

px 

0.45 

26 

cz 

1.79578 

27 

so 

1.79578 

28 

so 

1.8 

29 

so 

3.0 

c 


c  Transport  electrons  and  photons 
mode  e  p 

c  Source  is  defined  by  subroutine  " sourcedd2 . F"  (which  must  be  renamed 
c  to  "source. F") 

c  no.  of  histories 
nps  10000 

c 

c  electron  cutoff  energy  =  0.5  MeV 

cut:e  l.e+10  0.5 

c  photon  cutoff  energy  =  10  keV 

cut :p  l.e+10  0.01 

c 

c  materials 
c 

c  aluminum 
Ml  13027  -1.0 

C  Silicon 

M2  14000  -1.0 

C  Aluminum  Oxide 

M3  13027  -0.529251  8016  -0.470749 

C  Kel-F  (chlorotrif luoroethylene  C2C1F3) 

M4  6000  -0.20625  17000  -0.30440  9019  -0.48935 

c 

c  maximum  electron  energy (MeV)  needed  for  cross  sections 

phys:e  12. 

c  maximum  photon  energy (MeV)  needed  for  cross  sections 

phys : p  12. 

c  tallies 

c  energy  deposition  (MeV)  tally 
*F18 : e  1  5  13 

c  pulse  height  tally 
F48:e  1  5  13 

E48  0  l.e-5  .1  971  9.9  9.99999  10. 

c  cell  importances  for  electrons 

impre  1  17R  0 

c  cell  importances  for  photons 

imp:p  1  17R  0 
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Appendix  7 


ITS-ACCEPT  Subroutine  Modifications  for 
Dome  Source  Option 
-  Code  Listings  - 


SUBROUTINE  INPUT 

INPUT 

00007 

c 

*************************************** *******************************INPUT 

00009 

c 

INPUT 

00010 

c 

PROGRAM  INPUT  IS  CALLED  BY 

INPUT 

00011 

c 

ITS 

INPUT 

00012 

c 

PROGRAM  INPUT  CALLS 

INPUT 

00013 

c 

INTRINSIC  FUNCTIONS 

INPUT 

00014 

c 

REAL 

(TIGER  &  CYLTRAN) 

INPUT 

00015 

c 

SQRT,  ABS  (ACCEPT) 

INPUT 

00016 

c 

EXTERNAL  FUNCTIONS 

INPUT 

00017 

c 

ALIST, 

ELIST,  START,  PREP,  KOP, 

INPUT 

00018 

c 

REQALL, 

,  GEOMIN ,  SCRINF,  OPOPTS 

INPUT 

00019 

c 

KEYMAP, 

,  OPREAD 

INPUT 

00020 

c 

JOGEN 

(ACCEPT) 

INPUT 

00021 

c 

INPUT 

00022 

c 

ORIGINATION  DATE  12  DEC  67. 

INPUT 

00023 

c 

LAST  MODIFIED  17  MAY  91 

INPUT 

00024 

c 

INPUT 

00025 

c 

FUNCTION 

INPUT 

00026 

c 

THIS  PROGRAM  IS  USED  TO  READ 

AND  PROCESS  USER- SUPPLIED 

INPUT 

00027 

c 

CARD  INPUT 

INPUT 

00028 

c 

INPUT 

00029 

c 

******************************************************************* ***INPUT 

00030 

c 

***  COMMON  BLOCKS  CNSTNT,  PARAMS,  OUT,  CALC,  XPED,  STTS,  SCALE, 

PLTITL INPUT 

00031 

c 

PAREM,  GOMLOC  (ACCEPT) 

INPUT 

00032 

c 

FLUOR  ( PCODES ) 

INPUT 

00033 

c 

PLOT  (PLOTS) 

INPUT 

00034 

C$ 

;  LIST (S=0) 

INPUT 

00035 

Code  listing  omitted  here  is  identical  to  that  given  in  Appendix  2 


C$  LIST (S=l)  INPUT 

CDIR$  LIST  INPUT 

COMMON  /SCALE/  BNUM,  XNUM  SCALE 

COMMON  /EXTSORC/  IRECTS , IDISKS , XLOWS , XHIGHS , YLOWS , YHIGHS , ZLOWS , 

$  ZHIGHS ,  XCENT ,  YCENT ,  ZCENT ,  XCIR ,  YCIR ,  ZCIR,  KPERPYZ ,  KPREPX2  ■  KPERPXY - 

$  IDOME ,  RDOMF  — 


SCALE 

INPUT 


COMMON  /HITS/EDPRCLO) ,EDNK(10) ,EDSC(10) ,EDTL(10) ,LHCL(10) ,NINDV 


00051 

00052 

00002 


f  New 
Code 


00003 

00057 


o  n  o  non 


Code  listing  omitted  here  is  identical  to  that  given  in  Appendix  2 


C 

C 

c 

c 


NPRTCL  =  1 

IRECTS  =  0 
IDISKS  =  0 
KPERPYZ  =  0 
KPERPXZ  *  0 
KPERPXY  *  0 
I DOME  -  0 

NINDV=0 
DO  599  J=l, 


INPUT 


599 

C 


60 


10 


LHCL(J) 

=  1 

[) 

INPUT 

TITLE 

- 

f  i 

INPUT 

NPRT 

= 

12 

INPUT 

I  ECHO 

ss 

0 

INPUT 

NB 

* 

10 

INPUT 

IMAX 

1000 

INPUT 

IBT 

* 

0 

INPUT 

MBSC 

JS 

1 

INPUT 

BOLD 

CZERO 

INPUT 

IMXOLD 

0 

INPUT 

INRAN 

* 

CZERO 

INPUT 

BASE 

s 

CTWO 

INPUT 

XNCYC 

= 

CEIGHT 

INPUT 

TMFAC 

K 

BASE** { ~1 . 0 /XNCYC) 

INPUT 

DMPFLG 

= 

.FALSE. 

INPUT 

INITIALIZE  LOGICALS  FOR  IDENTIFYING  MATERIALS  (NON-P  CODES)  OR 
ELEMENTS  (P  CODES)  THAT  ARE  PRESENT  IN  A  GIVEN  PROBLEM  -  USED 
FOR  IDENTIFYING  RELEVANT  LINE  RADIATION. 

NGP  =  NMT 
DO  60  J=1 ,NGP 

FLMTEL(J)  «=  .FALSE. 

NPLOTS  *  0 


SOURCE  VARIABLES 


FLESRC 

JSPEC 

FLSPEC 

TIN 

TPCUT 

TCUT 

TSAVE 

ICTH 

CTSR 

CTHIN 

ZSR 

XSR 

YSR 

CPSR 

SORCIN 


.TRUE. 

0 

. FALSE . 
CONE 
C1EM2 
CZERO 
CZERO 
1 

CZERO 

C90 

CZERO 

CZERO 

CZERO 

CZERO 

CZERO 


ELECTRON  ESCAPE  VARIABLES 


INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 

INPUT 


00153 


00154 

00155 

00156 

00157 

00158 

00159 

00160 

00161 

00162 

00163 

00168 

00170 

00171 

00172 

00173 

00174 

00175 

00176 

00177 

00182 

00184 

00185 

00186 

00188 

00193 

00194 

00195 

00196 

00197 

00198 

00199 

00200 

00201 

00202 

00203 

00204 

00205 

00210 

00213 

00214 

00215 

00216 

00218 

00219 

00220 
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JMAX  -  10 

INPUT 

00221 

FLESC  =  .FALSE. 

INPUT 

00222 

ITMK  =  1 

INPUT 

00223 

IAMK  =  1 

INPUT 

00224 

KMAX  =  18 

INPUT 

00225 

KMAZ  =1 

INPUT 

00226 

IAMKZ  =  1 

INPUT 

00228 

c 

INPUT 

00230 

c  « 

PHOTON  ESCAPE  VARIABLES 

INPUT 

00231 

c 

INPUT 

00232 

JPMAX  =  10 

INPUT 

00233 

FLESCP  =  .FALSE. 

INPUT 

00234 

IPMK  =  1 

INPUT 

00235 

IBMK  =  1 

INPUT 

00236 

KPMAX  =  18 

INPUT 

00237 

KPMAZ  =  1 

INPUT 

00238 

IBMKZ  =  1 

INPUT 

00240 

c 

INPUT 

00242 

c 

»  «  • 

ELECTRON  FLUX  VARIABLES 

INPUT 

00243 

c 

INPUT 

00244 

FLFLUX  *  .FALSE. 

INPUT 

00245 

JFMAX  =  10 

INPUT 

00246 

KFMAX  =  6 

INPUT 

00247 

KFMAZ  =  1 

INPUT 

00248 

IFAMKZ  =  1 

INPUT 

00250 

IFMK  =  1 

INPUT 

00252 

IFAMK  =  1 

INPUT 

00253 

c 

INPUT 

00254 

c 

PHOTON  FLUX  VARIABLES 

INPUT 

00255 

c 

INPUT 

00256 

FLFLXP  =  .FALSE. 

INPUT 

00257 

JFMAX P  =  10 

INPUT 

00258 

KFMAX P  *  6 

INPUT 

00259 

KFMAZ P  =  1 

INPUT 

00260 

IFBMKZ  =  1 

INPUT 

00262 

IFMKP  =  1 

INPUT 

00264 

IFBMK  =  1 

INPUT 

00265 

c 

— 

INPUT 

00266 

c 

•  •  • 

PULSE  HEIGHT  DISTRIBUTION 

VARIABLES 

INPUT 

00267 

c 

— 

INPUT 

00268 

FLPHD  =  .FALSE. 

INPUT 

00269 

JSMAX  =  12 

INPUT 

00270 

IPHMK  =  1 

INPUT 

00271 

c 

INPUT 

00272 

c 

*********************************************** 

INPUT 

00273 

c 

*  BEGIN  READING 

INPUT 

* 

INPUT 

00274 

c 

*  ZERO-LEVEL  KEYWORDS  IN 

ALPHABETICAL  ORDER 

* 

INPUT 

00275 

c 

*********************************************** 

INPUT 

00276 

c 

INPUT 

00280 

c 

,  ,  , 

SET  ERROR  TRAP  FLAG  TO  ZERO 

INPUT 

00281 

IERTRP  =  0 

INPUT 

00282 

NUMCRD  =  0 

INPUT 

00283 

FLNEWD  =  . FALSE . 

INPUT 

00284 

FLDUP  =  . FALSE . 

INPUT 

00285 

DO  65  IKEY=1 , MAXKEY 

INPUT 

00286 

65 

FLKEY { IKEY )  =  .FALSE. 

INPUT 

00287 

c 

INPUT 

00288 

c 

•  .  • 

READ  THE  NEXT  CARD  IN  THE 

INPUT  FILE 

INPUT 

00289 

c 

INPUT 

00290 

c 

INPUT 

00291 

7  o' 

CALL  OPREAD ( 1 , IECHO  f  EOFLAG) 

INPUT 

00292 

c 

— 

INPUT 

00293 

c 

INPUT 

00294 

c 

•  *  * 

NOTE,  COMMENT  CARDS  DENOTED 

BY  *  IN  COLUMN  1, 

SKIPPED  INTERNALLY 

INPUT 

00295 

c 

INPUT 

00296 

IF  (.NOT.  EOFLAG)  THEN 

INPUT 

00297 

NUMCRD  a  NUMCRD  +  1 

INPUT 

00298 

c 

INPUT 

00299 

80 

IF  (KOP( 'BATCHES*)  . GE . 

1) 

THEN 

INPUT 

00300 

c 

INPUT 

00301 

c 

.  .  . 

BATCHES 

INPUT 

00302 
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oonnnooooooo  oaonoonnooooo 


INPUT 

00303 

Check  if  primary  keyword  has  been  used 

INPUT 

00304 

INPUT 

00305 

I KEY  .  1 

INPUT 

00306 

INPUT 

00307 

IF  (FLKEY(IKEY)  )  CALL  KEYMAP  (IKE  Y,  FLDUP) 

INPUT 

00308 

INPUT 

00309 

FLKEY(IKEY)  -  .TRUE. 

INPUT 

00310 

INPUT 

00311 

NB  =  PARM(l) 

INPUT 

00312 

INPUT 

00313 

ELSE  IF  (KOP( ’CUTOFFS’)  .GE.  0)  THEN 

INPUT 

00314 

INPUT 

00315 

CUTOFFS 

INPUT 

00316 

INPUT 

00317 

I KEY  =  2 

INPUT 

00318 

INPUT 

00319 

IF  (FLKEY(IKEY) )  CALL  KEYMAP (I KEY, FLDUP) 

INPUT 

00320 

INPUT 

00321 

FLKEY (I KEY)  *  .TRUE. 

INPUT 

00322 

INPUT 

00323 

KARG  =  KOP(’ CUTOFFS’) 

INPUT 

00324 

IF  (KARG  .GE.  1)  THEN 

INPUT 

00325 

TCUT  =  PARM(l) 

INPUT 

00326 

END  IF 

INPUT 

00327 

IF  (KARG  .GE.  2)  THEN 

INPUT 

00328 

TPCUT  =  PARM (2) 

INPUT 

00329 

END  IF 

INPUT 

00330 

INPUT 

00331 

ELSE  IF  (KOP( ' DETAIL- IONIZE ' )  .GE.  0)  THEN 

INPUT 

00332 

INPUT 

00333 

DETAIL- IONI ZATION 

INPUT 

00334 

INPUT 

00335 

I KEY  =  33 

INPUT 

00336 

INPUT 

00337 

IF  (FLKEY (IKEY) )  CALL  KEYMAP (I KEY, FLDUP) 

INPUT 

00338 

INPUT 

00339 

FLKEY  (IKEY)  =  .TRUE. 

INPUT 

00340 

INPUT 

00341 

NPRTCL  *  2 

INPUT 

00342 

INPUT 

00343 

ELSE  IF  (KOP{ ’RECTANGLE -SOURCE ’) .GE.O) THEN 


RECTANGULAR  PLANE  SOURCE 


C 

c 

c 

c 


I KEY  *  34 


IF  (FLKEY(IKEY) )  CALL  KEYMAP ( I KEY, FLDUP) 


FLKEY(IKEY)  -  .TRUE. 


KARG  =  KOP{' RECTANGLE -SOURCE’) 
IF ( KARG . LT . 6 ) THEN 

WRITE (TOUT, 68) 


68  FORMAT  (IX,  *»»>’) 

WRITE (IOUT, 51) 

WRITE (IOUT, 68) 

51  FORMAT  ( IX ,  *  USER  MUST  ENTER  6  NUMBERS  ( XLOW ,  XHIGH ,  YLOW ,  YHIGH ,  ZLOW , 
$ZHIGH)  TO  DEFINE  SOURCE  LOWER  AND  UPPER  COORDINATE  LIMITS  OF  SOURC 
$E  RECTANGLE’) 

CALL  ABORTX  ( '  INPUT  ’  ) 

ELSE 

IRECTS  «  1 
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n  o 


c 

c 


XLOWS  =  PARM(l) 

XHIGHS  =  PARM (2 ) 

YLOWS  =  PARM (3) 

YHIGHS  =  PARM (4) 

ZLOWS  *  PARM (5) 

ZHIGHS  =  PARM (6) 

END  IF 

ELSE  IF  (KOP ( 1  CIRCLE -SOURCE ' )  . GE . 0 ) THEN 


C  CIRCLE  PLANE  SOURCE 


I KEY  =  35 


IF  {FLKEY (IKEY) )  CALL  KEYMAP ( IKEY , FLDUP ) 


FLKEY(IKEY)  =  .TRUE. 


KARG  =  KOP ('CIRCLE -SOURCE') 

IF ( KARG . LT . 6 ) THEN 

WRITE ( IOUT ,68) 

WRITE (IOUT, 52) 

WRITE (IOUT, 68) 

52  FORMAT  (IX,'  USER  MUST  ENTER  6  NUMBERS  -  COORDINATES  OF  CIRCLE  CENT 
$ER  (XO,  YO,  ZO)  ,  AND  COORDINATES  A  POINT  ON  CIRCUMFERENCE '  /IX,  '  (XC ,  YC 
$,ZC)  TO  DEFINE  POSITION  AND  ORIENTATION  OF  SOURCE  CIRCLE') 


CALL  ABORTX ( ' INPUT ' ) 

ELSE 

IDISKS  *  1 
XCENT  =  PARM (1) 

YCENT  =  PARM (2) 

ZCENT  =  PARM (3) 

XCIR  *  PARM (4) 

YCIR  =  PARM (5) 

ZCIR  =  PARM (6) 

CALL  OPREAD ( 1 , IECHO, EOFLAG) 
IF(KOP( 'RADIUS' ) .GE.l)  THEN 
SORCIN  =  PARM (1) * 

ELSE 
GO  TO  80 
END  IF 


END  IF 


C 

c 

c 

c 

c 

c 

c 


ELSE  IF  (KOP ( ' INDIVIDUAL -HI STS ' ) . GE . 0 )  THEN 


RECORD  SINGLE  HISTORY  ENERGY  DEPOSITIONS 


IKEY  »  36 

IF  (FLKEY (IKEY) )  CALL  KEYMAP (IKEY, FLDUP) 

FLKEY ( IKEY )  =  .TRUE. 

KARG  =  KOP  ( '  INDIVIDUAL-HISTS  ' ) 

IF ( KARG . LT . 1 . OR .  KARG . GT . 1 0 ) THEN 
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688 


C 


WRITE (IOUT, 68) 

WRITE { IOUT ,688) 

WRITE (IOUT, 68) 

FORMAT  ( IX f  'USER  MUST  ENTER  NO  FEWER  THAN  1  AND  NO  MORE  THAN  10  CEL 
$L  NUMBERS  IN  WHICH  THE  ENERGY  DEPOSITION  *  /IX ,  'FOR  INDIVIDUAL  ELECT 
$RON  HISTORIES  ARE  TO  BE  RECORDED .  ' ) 


CALL  ABORTX ( ' INPUT » ) 

ELSE 

DO  689  KRRG= 1 , KARG 
689  LHCL (KRRG) =PARM (KRRG) 

NINDV=KARG 
WRITE ( IOUT ,587) 

WRITE (IOUT ,  588 ) (LHCL (KRRG) , KRRG=1 ,NINDV) 

588  FORMAT ( IX ,  ' ENERGY  DEPOSITION  FOR  INDIVIDUAL  HISTORIES  WILL  BE  RECO 

$RDED  ON  FILE  "EDSHOW.TXT"  FOR  CELL  NOS /5X, 1015) 

WRITE (IOUT, 587) 

587  FORMAT  (/IX,  »***★*****★**★***  +  *****★*****★*****★*■*********♦******** 

$/ IX , '****+****************★*******★**************************★**** 

$*******★****★****************+**************************,) 

END  IF 

c^ - 

ELSE  IF  (KOP{ 'DOME-SOURCE' ) .GE.0)THEN 
C  _ 


C  HEMISPHERICAL  DOME  SOURCE 

C  - 

I KEY  =  37 
C 


C 

C 

C 


IF  (FLKEY(IKEY)  )  CALL  KEYMAP  ( IKEY ,  FLDUP) 
FLKEY (I KEY)  -  .TRUE. 

KARG  =  KOP ( » DOME - SOURCE ' ) 

IF (KARG . LT . 4 ) THEN 

WRITE (IOUT, 68) 

WRITE (IOUT, 53) 


53 

C 


WRITE  (IOUT,  68) 

FORMAT  (IX,  '  USER  MUST  ENTER  4  NUMBERS  -  COORDINATES  OF  SPHERE  CENT 
$ER  (XO,YO,ZO) ,AND  SPHERE  RADIUS '/ IX,  '  (RDOME)  ' ) 


CALL  ABORTX ('INPUT') 

ELSE 

I DOME  =  1 
XCENT  =  PARM(l) 

YCENT  =  PARM (2 ) 

ZCENT  *=  PARM  (3) 

RDOME  =  PARM (4) 


C 

ELSE  IF  ( KOP { 'DIRECTION')  .GE.  0)  THEN 

C  _ 

C  . . .  DIRECTION 


INPUT  00344 
INPUT  00345 
INPUT  00346 
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c 

c 

c 

c 


I KEY  «  3 


IF  (FLKEY(IKEY) )  CALL  KEYMAP ( I KEY , FLDUP ) 


FLKEY(IKEY)  =  .TRUE. 


INPUT 

00347 

INPUT 

00348 

INPUT 

00349 

INPUT 

00350 

INPUT 

00351 

INPUT 

00352 

INPUT 

00353 

Remaining  portion  of  subroutine  INPUT  (omitted  here  for  brevity)  is 
identical  to  original  ACCEPT  [1]  code 


END 


INPUT  01841 
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SUBROUTINE  KEYMAP (INDX, FLDUP) 

KEYMAP 

00003 

c  ****4*44*4  44*44***44  **********  ************************************** 

00004 

C 

KEYMAP 

00005 

c 

SUBROUTINE  KEYMAP  IS  CALLED  BY 

KEYMAP 

00006 

C 

INPUT 

KEYMAP 

00007 

c 

SUBROUTINE  KEYMAP  CALLS 

KEYMAP 

00008 

c 

INTRINSIC  FUNCTIONS 

KEYMAP 

00009 

c 

KEYMAP 

00010 

c 

EXTERNAL  FUNCTIONS 

KEYMAP 

00011 

c 

KEYMAP 

00012 

c 

KEYMAP 

00013 

c 

ORIGINATION  DATE  15  AUG  90 

KEYMAP 

00014 

c 

LAST  MODIFIED  11  MARCH  91 

KEYMAP 

00015 

c 

KEYMAP 

00016 

c 

FUNCTION 

KEYMAP 

00017 

c 

This  subroutine  contains  the  INPUT  Primary  Keyword  mapping. 

KEYMAP 

00018 

c 

It  takes  the  "indx"  of  the  keyword  list  array  as  input  and 

KEYMAP 

00019 

c 

returns  the  status  of  the  duplicate  keyword  flag,  "fldup". 

KEYMAP 

00020 

c 

KEYMAP 

00021 

c 

INPUT  PARAMETERS 

KEYMAP 

00022 

c 

INDX  -  Index  of  the  keyword  list  array 

KEYMAP 

00023 

c 

KEYMAP 

00024 

c 

OUTPUT  PARAMETERS 

KEYMAP 

00025 

c 

FLDUP  -  Status  of  the  duplicate  keyword  flag 

KEYMAP 

00026 

c 

KEYMAP 

00027 

C  ★★*44444*444**444*444444*444*4444444444444444444*4444**444444444*4444 

♦KEYMAP 

00028 

c  *** 

COMMON  BLOCKS  CNSTNT,  PARAMS 

KEYMAP 

00029 

c$ 

LIST (S=0) 

KEYMAP 

00030 

CDIR$ 

NOLIST 

KEYMAP 

00031 

No  changes  in  CNSTNT  common  block  -  listing,  omitted  for  brevity,  is  identical  to 

that  given  in  Reference  1. 

C 

c - 

^PARAMS 

‘PARAMS 

00002 

00003 

PARAMS  common  block  identical  to  that  shown  in  subroutine  INPUT  listed  in 
Appendix  2. 


C$  LIST (S=l) 

CDIR$  LIST 
C 

CHARACTER* 17  OKEYLS (MAX KEY) 

LOGICAL  FLDUP 
C 

DATA  OKEYLS  / 1 BATCHES ' ,  ' CUTOFFS ' , 

$  •DIRECTION',  * DUMP ' ,  'ECHO', 

$  *  ELECTRONS ' ,  *  ELECTRON -ESCAPE ' ,  • ELECTRON- FLUX ' , 

$  'ENERGY' ,  'GEOMETRY',  'HISTORIES',  'NEW-DATA-SET ' , 

$  ' NEXT -EVENT- ESCAPE '  ,  'NO-KNOCKONS  '  ,  ' NO- STRAGGLING '  , 

$  ' PHOTONS ' ,  ' PHOTON -ESCAPE •  ,  ' PHOTON- FLUX ' ,  ' PLOTS ' , 

$  'POSITION',  'PRINT-ALL',  '  PULSE -HEIGHT  * , 

$  ' RANDOM- NUMBER '  ,  'RESTART',  ' SCALE -BREMS ’  , 

$  '  SCALE- IMPACT  '  ,  '  SIMPLE -BREMS  '  ,  'SPECTRUM',  'TITLE  '  , 

$  'TRAP -ELECTRONS'  ,  ' NO- COHERENT '  ,  ' NO- INCOH -BINDING ' , 

C  $  ' DETAIL - IONIZE ' / 

$  *  DETAIL - 1 ONI ZE ' ,  *  RECTANGLE - SOURCE ' ,  ' CIRCLE - 

$  '  INDIVIDUAL-HISTS  '  ,  'DOME-SOURCE »  / 


KEYMAP 

00034 

KEYMAP 

00035 

KEYMAP 

00036 

KEYMAP 

00037 

KEYMAP 

00038 

KEYMAP 

00039 

KEYMAP 

00040 

KEYMAP 

-  00041 

KEYMAP 

00042 

KEYMAP 

00043 

KEYMAP 

00044 

KEYMAP 

00045 

KEYMAP 

00046 

KEYMAP 

00047 

KEYMAP 

00048 

KEYMAP 

00049 

KEYMAP 

Qpnnn. 

"V. 


New 

code 


C 

C 


C 


C 

Print  that  the  keyword  pointed  to  by  INDX  is  a  duplicate  entry 

WRITE  ( IOUT ,'('  '  >>>>  KEYMAP:  DUPLICATE  INPUT  KEYWORD:  ",  (A))') 

$  OKEYLS (INDX) 

IF  (.NOT.  FLDUP)  FLDUP  =  .TRUE. 

RETURN 

END 


KEYMAP 

00051 

KEYMAP 

00052 

KEYMAP 

00053 

KEYMAP 

00054 

KEYMAP 

00055 

KEYMAP 

00056 

KEYMAP 

00057 

KEYMAP 

00058 

KEYMAP 

00059 
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SUBROUTINE  SRCINF  { IMXOLD) 

SRCINF 

00002 

c 

********************************** ****** ******************************SRCINF 

00003 

c 

SRCINF 

00004 

c 

PROGRAM  SRCINF  IS  CALLED  BY 

SRCINF 

00005 

c 

INPUT 

SRCINF 

00006 

c 

PROGRAM  INPUT  CALLS 

SRCINF 

00007 

c 

INTRINSIC  FUNCTIONS 

SRCINF 

00008 

c 

MAX,  SIN,  COS,  SQRT 

SRCINF 

00009 

c 

EXTERNAL  FUNCTIONS 

SRCINF 

00010 

c 

ABORTX 

SRCINF 

00011 

c 

SRCINF 

00012 

c 

ORIGINATION  DATE  28  NOV  89 

SRCINF 

00013 

c 

LAST  MODIFIED  11  MARCH  91 

SRCINF 

00014 

c 

SRCINF 

00015 

c 

FUNCTION 

SRCINF 

00016 

c 

This  Subroutine  processes  the  SOURCE  Information 

SRCINF 

00017 

c 

SRCINF 

00018 

c 

INPUT  PARAMETERS 

SRCINF 

00019 

c 

IMXOLD  - 

SRCINF 

00020 

c 

SRCINF 

00021 

c 

OUTPUT  PARAMETERS 

SRCINF 

00022 

c 

NONE 

SRCINF 

00023 

c 

SRCINF 

00024 

c 

*************************************************************** *******SRCINF 

00025 

c 

***  COMMON  BLOCKS  CNSTNT,  PARAMS,  OUT,  CALC,  STTS 

SRCINF 

00026 

c$ 

LIST (S=0) 

SRCINF 

00027 

CDIR$  NOLIST 

SRCINF 

00028 

IMPLICIT  DOUBLE  PRECISION  (A-H,0-Z) 

CNSTNT 

00081 

SAVE 

CNSTNT 

00082 

No  changes  in  CNSTNT  common  block  -  listing,  omitted  for  brevity, 

is  identical 

that  given  in  Reference  1. 

c 

PARAMS 

00002 

C 

- PARAMS 

00003 

PARAMS  common  block  identical  to  that  shown  in  subroutine  INPUT  listed  in 
Appendix  2.  i  New 

COMMON  /EXTSORC/  IRECTS ,  IDISKS ,  XLOWS ,  XHIGHS ,  YLOWS ,  YHIGHS ,  2L0WS ,  _ 

$  2HIGHS  .  XCENT .  YCENT .  ZCENT .  XCIR .  YCIR ,  2CIR ,  KPERPYZ  .  KPRFPY7  KPFRPYTL. - -  COde 

$ 


I DOME , RDOME 
LOGICAL  RRKILL, 
COMMON  /OUT/ 

1  FLMTEL  ( INGP ) 


FLMTEL 


OUT 

OUT 

OUT 


00002 

00003 

00004 


No  changes  in  OUT  common  block  -  listing,  omitted  for  brevity,  is  identical  to  that 
given  in  Reference  1. 

C  CALC  00002 

COMMON  /CALC/  CALC  00003 

1  ACON  ( INMT )  #  ASTEP  ( INMAX,  INMT)  ,  AT  (NSURV ,  INMT )  ,  CALC  00004 

No  changes  in  CALC  common  block  -  listing,  omitted  for  brevity,  is  identical  to  that 


given  in  Reference  1. 

C 

CALC 

00139 

LOGICAL  DMPFLG,  FLMC 

STTS 

00002 

DOUBLE  PRECISION  IRSAV 

STTS 

00010 

COMMON  /STTS/  IB,  NB,  NSORS,  IBT,  BOLD,  BATCH, 

KPUTMX,  DMPFLG  STTS 

00017 

$  ,  IHIST,  IRSAV,  KPUT,  FLMC 

STTS 

00018 

C 

STTS 

00019 

C$  LIST (S=l) 

SRCINF 

00034 

CDIR$  LIST 

SRCINF 

00035 

C 

SRCINF 

00036 

WRITE(IOUT,  *  ( *  1 1************************ 1 1 / 

SRCINF 

00037 

$  '  *  *  SOURCE  INFORMATION  *  "  / 

SRCINF 

00038 

<5;  ti  ************************  t  »)  i  ) 

SRCINF 

00039 

C 

SRCINF 

00040 

IF  (FLESRC)  THEN 

SRCINF 

00041 

WRITE  { IOUT,  '  ( '  '  OSOURCE  ELECTRONS  ")’) 

SRCINF 

00042 

ELSE 

SRCINF 

00043 

WRITE (IOUT, '  (  " OSOURCE  PHOTONS' ' ) 1 ) 

SRCINF 

00044 

83 


c 

c 

c 

c 

c 


c 

c 


55 


54 


END  IF 

WRITE  { IOUT, ’('  'OTHE  MAXIMUM  SOURCE  ENERGY  IS '  • , T3 8 , F12 . 5 , 

$  • 1  MEV' ») ')  TIN 

WRITE ( IOUT , '(" OTHE  GLOBAL  ELECTRON  CUTOFF  ENERGY  IS  "  , T38 , F12 . 5 , 
$  ' 1  MEV' ' ) ')  TOUT 

WRITE ( IOUT,  '('  'OTHE  PHOTON  CUTOFF  ENERGY  IS '  ' , T38 , F12 . 5, 

$  1 '  MEV' ' ) ')  TPCUT 

IF  (TSAVE  .GT.  TCUT)  WRITE  ( IOUT ,'("  OTHE  GLOBAL  ELECTRON  TRAP*', 

$  1  *  PING  ENERGY  IS  "  , T38 ,  F12 .  5 ,  "  MEV")')  TSAVE 

IF  (FLSPEC)  THEN 

WRITE  (IOUT,  '(  "OSOURCE  SPECTRUM")') 

WRITE (IOUT, ' (1216) ' )  JSPEC 

WRITE (IOUT, ' ( » 'ONORMALIZED  CUMULATIVE  SPECTRUM' ' ) ' ) 

WRITE(IOUT, • (6F12.5) ' )  (SPECIN(J) ,  J=1 , JSPEC) 

IF  ( (SPECIN (1)  .NE.  CONE)  .OR.  (SPECIN (JSPEC)  .NE.  CZERO) )  THEN 
WRITE (IOUT,*)  ’  INPUT  CUMULATIVE  SOURCE  SPECTRUM  MUST  BE', 

$  ’  MONOTONICALLY  DECREASING  FROM  1.0  TO  0.0* 


CALL  ABORTX ( ' SRC INF ' ) 


END  IF 

WRITE  ( IOUT,  '  ("OSPECTRAL  ENERGIES  (MEV)")') 
WRITE(IOUT, ■ (6F12.5) ')  (ESP(J) ,J=1, JSPEC) 


.AND.  IDOME.EQ. 0)  THEN 


END  IF 

IF { IRECTS . EQ . 0  .AND.  IDISKS.EQ.O 

WRITE (IOUT, ' (' ' OCOORDINATES  OF  THE  POINT  SOURCE  OR  OF  THE' 

$  "  CENTER  OF  THE  BEAM  (DISK)  SOURCE  ARE"/ 

$  •  1  X  -  ",E12.5,"  CM '  *  ,  10X,  '  '  Y  *  ",E12.5, 

$  "  CM '  *  ,  10X,  '  '  Z  =  ",E12.5,"  CM")') 

$  XSR,  YSR,  ZSR 

WRITE  (IOUT,  '  ("OTHE  RADIUS  OF  THE  BEAM  (DISK)  SOURCE  IS  =  '  \ 
$  1PE12.4,"  CM")')  SORCIN 

END  IF 


I F (I DOME . E Q . 0 ) THEN 

WRITE (IOUT, ' (' ' 0 REFERENCE  DIRECTION  FOR  ANGULAR  DISTRIBUTION* ' , 

$  "  IS  DEFINED  BY"/"  THETA  =  ",G11.4, 

$  "  DEGREES"  ,  10X,  "PHI  «=  ",G11.4,"  DEGREES")') 

$  CTSR,  CPSR 

TEMPA  «  CTSR/C180PI 
CTSR  =  COS (TEMPA) 

STSR  =  SIN (TEMPA) 

TEMPA  =  CPSR/C180PI 
CPSR  =  COS (TEMPA) 

SPSR  *  SIN (TEMPA) 

END  IF 

IF ( IRECTS . EQ . 1 ) THEN 

WRITE { IOUT , 55 ) XLOWS , XHIGHS , YLOWS , YHIGHS , ZLOWS , ZHIGHS 
FORMAT (/ /IX ,* RECTANGULAR  PLATE  SOURCE, ' /5X, 'BOUNDING  COORDINATES 


SRCINF 

00045 

SRCINF 

00046 

SRCINF 

00047 

SRCINF 

00048 

SRCINF 

00049 

SRCINF 

00050 

SRCINF 

00051 

SRCINF 

00052 

SRCINF 

00053 

SRCINF 

00054 

SRCINF 

00055 

SRCINF 

00056 

SRCINF 

00057 

SRCINF 

00058 

SRCINF 

00059 

SRCINF 

00060 

SRCINF 

00061 

SRCINF 

00062 

SRCINF 

00063 

SRCINF 

00064 

SRCINF 

00065 

SRCINF 

00066 

SRCINF 

00067 

SRCINF 

00068 

SRCINF 

00069 

SRCINF 

00070 

SRCINF 

00071 

SRCINF 

00072 

SRCINF 

00083 

SRCINF 

00084 

SRCINF 

00085 

SRCINF 

00086 

SRCINF 

00087 

SRCINF 

00088 

SRCINF 

00089 

SRCINF 

00095 

SRCINF 

00090 

SRCINF 

00091 

SRCINF 

00092 

SRCINF 

00093 

SRCINF 

00096 

SRCINF 

00097 

SRCINF 

00099 

SRCINF 

00100 

SRCINF 

00101 

SRCINF 

00102 

XHIGH  '  ,E12.5/10X,  'YLOW  =  '  ,  E12 . 5 
ZHIGH  =  ' , E12 . 5) 


$RE  -  ' /10X, 'XLOW  =  ' , E12 . 5 , * 

$, '  YHIGH  =  * ,E12.5/10X, ' ZLOW  =  *,E12.5, 

IF (ABS (XHIGHS -XLOWS) . LE . CT1EM7 ) KPERPYZ= 1 
IF (ABS (YHIGHS -YLOWS) . LE . CT1EM7 ) KPERPXZ=1 
IF (ABS (ZHIGHS -ZLOWS) . LE . CT1EM7 ) KPERPXY= 1 
KPRPSUM=KPERPYZ+KPERPXZ+KPERPXY 
IF (KPRPSUM . EQ . 0  .OR.  KPRPSUM . EQ . 3 ) THEN 
WRITE (IOUT, 54) 

FORMAT (I I flX, ' PROBLEM  IN  DEFINITION  OF  SOURCE  PLANE  ORIENTATION ' ) 
CALL  ABORTX ( ' SRCINF ' ) 

END  IF 
END  IF 


New 

code 


IF ( IDISKS . EQ . 1) THEN 


84 


56 


WRITE ( IOUT , 56 ) XCENT , YCENT , ZCENT , XCIR , YCIR , ZCIR 
FORMAT  (//IX,  'CIRCULAR  DISK  SOURCE  ' /5X,  1  COORDINATES  OF  CENTER  ARE'/ 
$10X,  'XCENTER  =  '(E12.5,'  YCENTER  =  ',E12.5,'  ZCENTER  «  '  ,  E12 . 5 
$//5X, 'COORDINATES  OF  POINT  ON  CIRCUMFERENCE  ARE ' /10X, ' XCIR  = 

$E12 . 5 , '  YCIR  =  ' , E12 . 5 , *  ZCIR=  *,E12.5) 

IF (ABS (XCENT -XCIR) . LE . CT1EM7 ) KPERPYZ=1 
IF (ABS (YCENT-YCIR) . LE . CT1EM7 ) KPERPXZ=1 
IF (ABS (ZCENT -ZCIR) . LE . CT1EM7 ) KPERPXY=1 
KPRPSUM=KPERP  Y  Z + KPERPX  Z + KPERPXY 
IF ( KPRPSUM . EQ . 0  .OR.  KPRPSUM . EQ . 3 ) THEN 
WRITE (IOUT, 54) 

CALL  ABORTX ( ' SRCINF ' ) 

END  IF 


C 

IF { SORCIN . EQ . CZERO) THEN 
WRITE (IOUT, 57) 

CALL  ABORTX ('SRCINF') 
END  IF 
C 


RSSQQ=SQRT(  (XCENT-XCIR)  **2+  (YCENT-YCIR)  **2+  (ZCENT-ZCIR)  **2) 
IF  (ABS  (RSSQQ- SORCIN)  .GT.CT1EM7)  THEN 

WRITE  (IOUT,  58) 

CALL  ABORTX {'SRCINF') 

ELSE 

SORCIN=RSSQQ 

WRITE (IOUT, 59) SORCIN 

59  FORMAT (/IX, 'RADIUS  OF  THE  DISK  SOURCE  IS  *,E12.5) 

END  IF 

57  FORMAT  (///IX,  'SOURCE  DISK  RADIUS  NOT  SPECIFIED') 

58  FORMAT  (///IX, 'SOURCE  DISK  RADIUS  INCONSISTENT  WITH  SPECIFICATION  0 
$F  POINTS  ON  CIRCUMFERENCE  AND  AT  CENTER  OF  SOURCE  DISK') 


END  IF 


IF ( IDOME . EQ. 1) THEN 

WRITE { IOUT ,61) XCENT , YCENT , ZCENT , RDOME 
61  FORMAT (//IX,  'HEMISPHERICAL  DOME  SOURCE* /5X,  ' COORDINATES  OF  SPHERE 
$ CENTER  ARE'/ 

$10X, 'XCENTER  =  ' , E12 . 5 , ’  YCENTER  =  ',E12.5, 

$//5X, 'DOME  RADIUS  =  ',E12.5) 

END  IF 


ZCENTER  =  ' , E12 . 5 


C 

C 

C 

C 

C 

C 

C 


This  code  block  checks  to  see  if  the  sine  of  the  input  polar 
angle  direction  is  less  than  zero.  If  it  is,  it  allows  this 
condition  within  an  acceptable  tolerance  and  changes  the  sine 
of  the  angle  to  zero;  else  it  aborts. 

IF  (STSR  .LT.  CZERO)  THEN 
IF  (STSR  .GT.  -C1EM6 )  THEN 

WRITE  (IOUT,  '(//,''  >»>  SRCINF:  WARNING!  SINE  OF  SOURCE'  '  ( 
$  •  '  INPUT  POLAR  ANGLE  DIRECTION  IS  CHANGED  TO  ZERO.  '  1 

STSR  =  CZERO 
CTSR  =  SIGN (CONE, CTSR) 

ELSE 

WRITE  (IOUT,  '  {//,  '  '  »>>  THE  INPUT  POLAR  ANGLE  WITH  THE*  '  , 


SRCINF 

00103 

SRCINF 

00104 

SRCINF 

00105 

SRCINF 

00106 

SRCINF 

00107 

SRCINF 

00108 

SRCINF 

00109 

SRCINF 

00110 

SRCINF 

00111 

1  ) SRCINF 

00112 

SRCINF 

00113 

SRCINF 

00114 

SRCINF 

00115 

SRCINF 

00116 

85 


non  non  oon  o  o  o  o  o  o  o  o  o  no 


c 

c 


c 


c 

c 


$  * '  DIRECTION  KEYWORD  MUST  BE  BETWEEN  ZERO  AND  180 ?\  SRCINF  00117 

$  11  DEGREES.*')')  SRCINF  00118 

— _  SRCINF  00119 

CALL  ABORTX  (' SRCINF  •  )  SRCINF  00120 


END  IF 
END  IF 


IF (IRECTS. EQ. 0  .AND.  IDISKS.EQ.O  .AND. 
WSRX  =  STSR*CPSR 
WSRY  =  STSR*SPSR 
WSRZ  =  CTSR 


...  USUALLY  W1 (V)  *  R(V)  X  OMEGA (V) 


W1X  *  YSR*WSRZ  -  ZSR*WSRY 

W1Y  =  ZSR*WSRX  -  XSR*WSRZ 

W1Z  *  XSR*WSRY  -  YSR*WSRX 

XNRM  =  W1X*W1X  +  W1Y+W1Y  +  W1Z*W1Z 


...  UNLESS  R (V)  X  OMEGA (V)  *  0 


IF  {XNRM  .EQ.  CZERO)  THEN 


IF  I(V)  *  OMEGA (V)  -  0,  W1 (V)  =  I (V) 


SRCINF  00121 
SRCINF  00122 


IDOME.EQ. 0)  THEN 

SRCINF  00126 
SRCINF  00127 
SRCINF  00128 
SRCINF  00129 
SRCINF  00130 
SRCINF  00131 
SRCINF  00132 
SRCINF  00133 
SRCINF  00134 
SRCINF  00135 
SRCINF  00136 
SRCINF  00137 
SRCINF  00138 
SRCINF  00139 
SRCINF  00140 


SRCINF  00125 


IF  (WSRX  .EQ.  CZERO)  THEN 
W1X  =  CONE 
W1Y  =  CZERO 
W1Z  =  CZERO 


IF  J(V)  *  OMEGA (V)  =  0,  W1  (V)  =  J(V) 


SRCINF  00141 
SRCINF  00142 
SRCINF  00143 
SRCINF  00144 
SRCINF  00145 
SRCINF  00146 
SRCINF  00147 


ELSE  IF  (WSRY  .EQ.  CZERO)  THEN 
W1X  =  CZERO 
W1Y  =  CONE 
W1Z  =  CZERO 


IF  K  (V)  *  OMEGA  (V)  =0,  W1  (V)  =  K(V) 


ELSE  IF  (WSRZ  .EQ.  CZERO)  THEN 
W1X  «=  CZERO 
W1Y  =  CZERO 
W1Z  =  CONE 


OTHERWISE,  W1  (V)  =  +OR-  K(V)  X  OMEGA (V) 


ELSE 

W1Z  *  CZERO 

W1X  *  CONE/ SQRT  ( CONE  +  ( WSRX/ WSRY)  *  *2) 
W1Y  *  -W1X* WSRX /WSRY 
END  IF 
ELSE 

XNRM  =  SQRT  (XNRM) 

W1X  =  W1X/XNRM 
W1Y  =  W1Y/XNRM 
W1Z  =  W1Z/XNRM 
END  IF 


W2X  «  WSRY*W1Z  -  WSRZ*W1Y 
W2Y  =  WSRZ*W1X  -  WSRX*W1Z 
W2Z  =  WSRX*W1Y  -  WSRY*W1X 
XSR  =  XSR  +  CT1EM7  *WSRX 
YSR  -  YSR  +  CT1EM7  *WSRY 
ZSR  «  ZSR  +  CT1EM7  *WSRZ 
IF  { SORCIN  .EQ.  CZERO)  THEN 
XSR  *  XSR+CT1EM7*W1X 
YSR  -  YSR+CT1EM7  *W1 Y 
ZSR  =  ZSR+CT1EM7  *W1Z 
END  IF 


END  IF 

IF (IDOME .EQ. 0) THEN 

( ICTH  .EQ.  1)  THEN- 


IF 


New 

F  (ICTH  .EQ.  1)  THEN -  - -  code 

WRITE  (IOUT,  •  (•  ?  OMONODIRECTIONAL  SOURCE  IN  REFERENCE  ^ 
$  *  *  DIRECTION* ')  *) 

ELSE  IF  (ICTH  .EQ.  2)  THEN 

WRITE (IOUT,  '  { *  *  OISOTROPIC  SOURCE  TRUNCATED  AT  *  ■ ,G11. 
$  ' *  DEGREES  WITH  RESPECT  TO  REFERENCE  DIRECTION' 

CTHIN  «  COS (CTHIN/C180PI) 


SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 


SRCINF 

SRCINF 
SRCINF 
SRCINF 
SRCINF 
,  SRCINF 

) * )  CTHIN  SRCINF 
SRCINF 


00148 

00149 

00150 

00151 

00152 

00153 

00154 

00155 

00156 

00157 

00158 

00159 

00160 

00161 

00162 

00163 

00164 

00165 

00166 

00167 

00168 

00169 

00170 

00171 

00172 

00173 

00174 

00175 

00176 

00177 

00178 

00179 

00180 

00181 

00182 

00183 

00184 

00185 


00187 

00188 

00189 

00190 

00191 

00192 

00193 

00194 


86 


non 


c 


c 


c 

c 

c 


c 

c 

c 


ELSE 

WRITE (IOUT, 1 { 1 1 0 CO SINE -LAW  SOURCE  TRUNCATED  AT  ' 1 ,G11.4, 

$  1  1  DEGREES  WITH  RESPECT  TO  REFERENCE  DIRECTION1  1 )  *)  CTHIN 

CTHIN  =  COS (CTHIN/C180PI) **2 
END  IF 

END  IF  _ 


New 

code 


IF  (NB  .LE.  0)  NB  =  10  '  _ 

IF  (IMAX  .LT.  NB)  I  MAX  =  NB 
IMAX  =  IMAX/NB 

IF  { (IBT  .NE.  0)  .AND.  (IMAX  ,NE .  IMXOLD) )  THEN 

.  .  BATCH  SIZES  INCONSISTENT  ON  RESTART  -  TERMINATE  RUN 

WRITE  ( IOUT,  1  (  1  '0***  FATAL  ERROR  ON  ATTEMPTED  RESTART  ***11/ 

$  * '  NEW  BATCH  SIZE  =  1 1 ,110, 1 1  DOESNT  EQUAL  OLD  BATCH  SIZE  = 

$  110/ 1 1  BATCH  SIZES  MUST  MATCH  TO  CORRECTLY  ACCUMULATE1 1 , 

$  11  STATISTICS1'  )')  IMAX,  IMXOLD 


CALL  ABORTS  (‘SrCIMFM 

END  IF 

NB  =  NB  +  IBT 

WRITE (IOUT, 1 ( 1 1 0THE  STANDARD  ERROR  ESTIMATES  ARE  BASED  ON  1 ',15, 
$  1 1  BATCHES  OF  1 1 , 17 ,  1  1  HISTORIES  EACH1 1 )  1 )  NB, IMAX 

RETURN 

END 


SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 

SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
,  SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 
SRCINF 


00195 

00196 

00197 

00198 

00199 

00200 

00201 

00202 

00203 

00204 

00205 

00206 

00207 

00208 

00209 

00210 

00211 

00212 

00213 

00214 

00215 

00216 

00217 

00218 

00219 

00220 

00221 

00222 

00223 

00224 

00225 


87 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

C$ 


SUBROUTINE  HIST  HIST 

******************************************+*************+************  *hist 

HIST 

SUBROUTINE  HIST  IS  CALLED  BY 

ITS 


SUBROUTINE  HIST  CALLS 
INTRINSIC  FUNCTIONS 


EXTERNAL  FUNCTIONS 


SQRT, 

REAL 


RANF 


(CYLTRAN) 


PHIST 

(CYLTRAN) 

(ACCEPT) 

(M-CODES) 


HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 
HIST 

ft**************************** ** + *  *  **  * + *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *hist 

***  COMMON  BLOCKS  CNSTNT,  PARAMS,  OUT,  CALC,  XPED,  STOR,  STTS,  HIST 

(PAREM)  -ACCEPT  HIST 

LIST(S=0)  HIST 


ORIGINATION  DATE 
LAST  MODIFIED 


16 

30 


CLASS,  ECROS,  EHIST,  TIMER, 

RANINT,  RANSAV 

ZONE 

FOLD ,  ZONEA 
PLTDAT 

JAN  68. 

MAY  91 


FUNCTION 

THIS  PROGRAM  SAMPLES  PHASE  SPACE  PARAMETERS  FOR 
SOURCE  PARTICLES.  SUBSEQUENTLY  CALLS  EITHER  EHIST  OR 
PHIST.  RETRIEVES  "BANKED"  ELECTRONS  AND  CALLS  EHIST. 
TALLIES  PULSE  HEIGHT  DISTRIBUTION. 


00007 

00009 

00010 

00011 

00012 

00013 

00014 

00015 

00016 

00017 

00018 

00019 

00020 

00021 

00022 

00023 

00024 

00025 

00026 

00027 

00028 

00029 

00030 

00031 

00032 

00033 

00034 

00035 

00036 

00037 


CDIR$  NOLIST  HIST 

No  changes  in  CNSTNT  common  block  -  listing,  omitted  for  brevity,  is  identical  to 
that  given  in  Reference  1. 


PARAMS  00002 

c  - - - - PARAMS  00003 

PARAMS  common  block  identical  to  that  shown  in  subroutine  INPUT  listed  in 
Appendix  2. 

COMMON  /EXTSORC/  IRECTS , IDISKS , XLOWS , XHIGHS , YLOWS , YHIGHS , ZLOWS , 

$  ZHIGHS ,  XCENT ,  YCENT ,  ZCENT ,  XCIR ,  YCIR ,  ZCIR,  KPERPYZ  .  KPRPpvz  - - - 

$  I  DOME ,  RDOME  ■■  . . 


New 

code 


FLMTEL 


OUT 

OUT 

OUT 


LOGICAL  RRKILL, 

COMMON  /OOT/ 

1  FLMTEL  (INGP) 

No  changes  in  OUT  common  block  -  listing,  omitted  for  brevity,  is 
given  in  Reference  1. 

C  CALC 

CALC 

ASTEP ( INMAX,  INMT)  ,  AT  (NSURV,  INMT)  ,  CALC 

No  changes  in  CALC  common  block  -  listing, ,  omitted  for  brevity,  is  identical  to  that 
given  in  Reference  1. 

C 


COMMON  /CALC/ 
1  ACON(INMT) , 


00002 
00003 
00004 

identical  to  that 

00002 
00003 
00004 


C 

C 


CALC 

00139 

XPED 

00002 

COMMON  /XPED/ 

XPED 

00003 

1  DETOUR (INMT) ,  RHO(INMT),  MT,  MTP 

,  MTP0 

XPED 

00010 

XPED 

00012 

LOGICAL  DMPFLG,  FLMC 

STTS 

00002 

DOUBLE  PRECISION  IRSAV 

STTS 

00010 

COMMON  /STTS/  IB,  NB,  NSORS,  ! 

IBT,  BOLD,  BATCH, 

KPUTMX,  DMPFLG  STTS 

00017 

$  ,  IHIST,  IRSAV,  KPUT ,  FLMC 

STTS 

00018 

STTS 

00019 

PAREM 

00002 

CHARACTER*  3  OTYPE (10),  OBODY 

PAREM 

00003 

LOGICAL  FLDBG,  FLDBGL 

PAREM 

00004 

COMMON  /PAREM/ 

PAREM 

00008 

$  XB ( 3 ) ,  WT ( 3 ) ,  RIN,  ROUT, 

PINF,  DIST, 

IR,  PAREM 

00009 

$  FLDBG,  IRPRIM,  ICALL,  LSURF, 

NBO,  LRI , 

LRO,  PAREM 

00013 

$  KLOOP,  LOOP,  ITYPE ,  FLDBGL 

PAREM 

00014 

88 


J 


* 


COMMON  /PAREMO/  OTYPE  PAREM 

C  PAREM 

COMMON  /HITS/EDPR  ( 10 )  ,  EDNK  ( 10 )  ,  EDSC  ( 10 )  ,  EDTL  ( 10 )  ,  LHCL  ( 10 )  ,  NINDV 
C$  LIST ( S=l)  HIST 

CDIR$  LIST  HIST 

COMMON  /STOR/  STOR 

1  CTHS  (NLAST),  TS  (NLAST)  ,  WS  (NLAST),  ZS  (NLAST)  f  IPRS  (NLAST)  ,  STOR 

2  LBS  (NLAST)  ,  NTS  (NLAST)  STOR 

$  ,  XS  (NLAST)  ,  YS  (NLAST)  ,  STHS  (NLAST)  ,  STOR 

3  CPHS (NLAST) ,  SPHS (NLAST)  STOR 

4  ,  LBCS  (NLAST)  STOR 

C  HIST 

EXTERNAL  RAN  RANNUM 

C  HIST 

CIMAX  =  IMAX  HIST 

IF  (FLSPEC)  THEN  HIST 

TAV  «  CZERO  HIST 

ELSE  HIST 

TAV  -  CIMAX*TIN  HIST 

END  IF  HIST 

C  _  HIST 

CALL  RANINT  (IRA)  HIST 

C  _  HIST 

IF  (IB  .EQ.  1)  INRAN  =  IRA  HIST 

DO  130  1=1,  IMAX  HIST 


DO  1301  JJJ=1,10 
EDPR ( JJJ) =0 . 
EDNK(JJJ) =0 . 
EDSC (JJJ) =0 . 


1301  EDTL (JJJ) =0. 


IHIST  =  I 

HIST 

MODTMJ  =  MIN (100, IMAX) 

LAHEY 

IF ( I . EQ . MODTMJ* (I/MODTMJ) )  THEN 

LAHEY 

CALL  TOTTIM (XTMJ) 

LAHEY 

WRITE ( * ,  1  ( / ■ ’  HISTORY  ' ' , 18 ,  1 1 ,  ELAPSED  MINUTES ' ' , F10 . 2 ) ' ) 

LAHEY 

H,XTMJ/60. 

LAHEY 

END  IF 

LAHEY 

W  =  CONE 

HIST 

CWCF  =  W 

HIST 

LAST  *  0 

HIST 

c 

HIST 

CALL  RANSAV  ( IRSAV) 

HIST 

c 

HIST 

c 

HIST 

c 

HIST 

c 

.  . .  SOURCE  ENERGY 

HIST 

c 

HIST 

IF  (FLSPEC)  THEN 

HIST 

RA  =  RAN  (IRAN) 

HIST 

DO  14  JHIST  =  2 , JSPEC 

HIST 

IF  (  RA.  GT.  SPECIN (JHIST)  )  GO  TO 

16 

HIST 

14  CONTINUE 

HIST 

16  T  -  ESP (JHIST-1)  +  (  RA  -SPECIN (JHIST 

-1)  )*(  ESP (JHIST) 

HIST 

$  -  ESP (JHIST-1)  )/(  SPECIN (JHIST)  -  SPECIN (JHIST 

-1)  ) 

HIST 

TAV  =  TAV  +  T 

HIST 

IF  (  { FLESRC  .AND.  (T  .GT.  TCUT  ))  .OR. 

HIST 

$  (.NOT.  FLESRC  .AND.  (T  .GT.  TPCUT) )  )  THEN 

HIST 

GO  TO  20 

HIST 

ELSE 

HIST 

NTREJ  =  NTREJ  +  1 

HIST 

TREJ  =  TREJ  +  W*T 

HIST 

GO  TO  1299 

HIST 

END  IF 

HIST 

END  IF 

HIST 

T  =  TIN 

HIST 

20  NT  =  NTFST 

HIST 

c 

HIST 

CALL  CLASS  (T,NT) 

New 

HIST 

c 

HIST 

c 

IF  ( IDOME  .  EQ .  0 )  THEN  _ _ _ ^  J 

HIST 
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00117 
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00126 
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00129 
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00137 
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SOURCE  DIRECTION 

HIST 

HIST 

IF  (ICTH  .EQ.  2)  THEN 

HIST 

RA  =  RAN ( IRAN) 

HIST 

COM  *  CTHIN+  RA*  (CONE-CTHIN) 

HIST 

ELSE  IF  (ICTH  .EQ.  3)  THEN 

HIST 

RA  *=  RAN  (IRAN) 

HIST 

COM  =  SQRT ( CTHIN+RA*  (CONE-CTHIN)  ) 

HIST 

ELSE  IF  (ICTH  .EQ.  1)  THEN 

HIST 

CTH(l)  =  CTSR 

HIST 

STH(l)  .  STSR 

HIST 

CPH ( 1 )  =  CPSR 

HIST 

SPH ( 1)  =  SPSR 

HIST 

GO  TO  69 

HIST 

END  IF 

HIST 

IF  (CTSR  .EQ.  CONE)  THEN 

HIST 

HIST 

CTH(l)  *  COM 

HIST 

STH(l)  *  SQRT ( CONE- COM*COM) 

HIST 

RA  -=  RAN  (IRAN) 

HIST 

JAZ  «=  RA*C360 

HIST 

CPH ( 1 )  *  CCH ( JAZ+1) 

HIST 

SPH (1)  =  SCH (JAZ+1) 

HIST 

ELSE 

HIST 

HIST 

CALL  FOLD {CTSR, STSR, CPSR, SPSR, COM, CTH{1) 


END  IF 
END  IF. 


. . .  SOURCE  POSITION 


69 


RA 
R 
RA 
JAZ 
SCHR 
CCHR 
IF 


IF  (SORCIN  .NE.  CZERO)  THEN 


RAN (IRAN) 

=  SQRT (RA) * SORCIN 
*=  RAN  (IRAN) 

-  RA+C360 
«=  SCH(JAZ+1) *R 
»  CCH (JAZ+1) *R 
(IDISKS  .EQ.  0)  THEN 

X  *  XSR  +  CCHR*W1X+SCHR*W2X 

Y  =  YSR+CCHR*W1Y+SCHR*W2Y 

Z  =  Z SR+ CCHR *W1Z+ SCHR* W2Z 

ELSE 

IF ( KPERPXY . EQ . 1 ) THEN 
X  *  XCENT  +  CCHR 

Y  *  YCENT  +  SCHR 

Z  *  ZCENT 

END  IF 

IF  (KPERPXZ . EQ. 1) THEN 

X  -  XCENT  +  CCHR 

Y  *  YCENT 

Z  =  ZCENT  +  SCHR 

END  IF 

IF ( KPERPYZ . EQ . 1 ) THEN 


STH(l) , CPH ( 1 ) , SPH (1) ) HIST 

. . . HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 

HIST 


XCENT 
Y  = 


YCENT  +  CCHR 


2  *=  ZCENT  +  SCHR 
END  IF 
END  IF 
ELSE 


IF  (IRECTS  .EQ.  0  .AND.  IDOME . EQ . 0 ) THEN 
X  -  XSR 
Y  =  YSR 
Z  =  ZSR 


HIST 

HIST 

HIST 

HIST 
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00157 
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00160 

00161 

00162 

00163 

00165 

00172 

00173 

00174 
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00177 

00178 

00179 

00198 

00199 

00200 

00201 
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00204 


00208 
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ELSE 

IF ( IRECTS . NE . 0 ) THEN 

RRAA1  -  RAN  (IRAN) 

RRAA2  *=  RAN  (IRAN) 

IF  ( KPERPXY  .EQ.  1)  THEN 

X  -  XLOWS  +  RRAA1*  (XHIGHS-XLOWS) 
Y  «  YLOWS  +  RRAA2*  ( YHIGHS-YLOWS) 
Z  =  ZLOWS 


2 


END  IF 

IF  (KPERPXZ.  EQ.  1)  THEN 

X  =  XLOWS  +  RRAA1* (XHIGHS-XLOWS) 
Y  -  YLOWS 

Z  =  ZLOWS  +  RRAA2*(ZHIGHS- ZLOWS) 
END  IF 

IF  ( KPERPYZ  . EQ . 1 )  THEN 
X  =  XLOWS 


Y  *  YLOWS  +  RRAA1*  (YHIGHS-YLOWS) 
Z  *  ZLOWS  +  RRAA2* (ZHIGHS- ZLOWS) 
END  IF 

END  IF _ 

IF  ( IDOME  .  NE  .  0 )  THEN 

STHDM=RAN ( IRAN )  \ 


CTHDM= SQRT ( 1 .  -STHDM*STHDM)  ' 

PPHDM=C2PI*RAN  ( IRAN) 

CPPHDM=COS (PPHDM) 

SPPHDM=SIN ( PPHDM) 

ALDM=  STHDM*CPPHDM 
BTDM= STHDM* SPPHDM 
X=RDOME  *  ALDM 
Y = RDOME  *  BTDM 
Z=RDOME*CTHDM 
PHSDM=C2PI*RAN  ( IRAN) 

CTHSDM=2 . +RAN ( IRAN) - 1 . 

STHSDM=SQRT ( 1 . -CTHSDM* CTHSDM) 
SPHSDM-SIN ( PHSDM) 

CPHSDM=COS (PHSDM) 

UUUD= STHSDM*CPHSDM 
VWD=  STHSDM*  S  PHSDM 
WWWD= CTHSDM 

AAAD=SQRT  (UUUD**2+VWD**2+WWWD**2) 

UUUD==UUUD/ AAAD 

VVVD-VVVD/AAAD 

wwwd=wwwd/aaad 

PRODD=ALDM*UUUD+BTDM*VWD+CTHDM*WW1 
IF ( PRODD . GT .0.0) GO  TO  106 
STH ( 1 ) = STHSDM 

CTH ( 1 ) = CTHSDM  , 

SPH ( 1 ) =SPHSDM  J 

CPH ( 1 ) =CPHSDM  / 

END  IF  / 


New 

code 


END  IF 

HIST 

00212 

HIST 

00213 

XB(1) 

=  X 

HIST 

00220 

XB  (2 ) 

*  Y 

HIST 

00221 

XB  (3 ) 

=  z 

HIST 

00222 

WT  (1) 

=  STH ( 1 ) *CPH ( 1 ) 

HIST 

00223 

WT  (2) 

=  STH(l) *SPH{1) 

HIST 

00224 

WTO) 

=  CTH (1) 

HIST 

00225 

HIST 

00226 

CALL 

ZONEA 

HIST 

00227 

— 

HIST 

00228 

LB 

=  IR 

HIST 

00229 
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LBCZ  =  IRPRIM 
IPR  =  1 


.  .  .  CALL  TRACKING  ROUTINES 


70  IF  (  FLESRC  .OR.  (IPR  .NE.  1)  )  THEN 

PARTICLE  TO  BE  TRACKED  IS  AN  ELECTRON 


IF  (MT  .NE.  MAT (LB) )  THEN 
MT  «  MAT  (LB) 

END  IF 


CALL  EHIST 


ELSE 


PARTICLE  TO  BE  TRACKED  IS  A  PHOTON 


LPCZ  «  LBCZ 


CALL  PHIST (X ,  Y,  Z  , LB, CTH { 1 ) ,STH(1) ,CPH(1) , SPH (1) , T, W, 1) 


END  IF 


. . .  REMOVE  SECONDARY  ELECTRONS  FROM  STORAGE  FOR  TRANSPORT 


IF  (LAST  .NE.  0)  THEN 
LB  =  LBS  (LAST) 

Z  -  ZS (LAST) 

T  =  TS (LAST) 

NT  =  NTS (LAST) 

CTH(l)  =  CTHS (LAST) 
W  =  WS  (LAST) 

IPR  =  IPRS (LAST) 

X  *  XS (LAST) 

Y  =  YS (LAST) 

STH { 1)  =  STHS (LAST) 
CPH { 1 )  =  CPHS (LAST) 
SPH ( 1)  -  SPHS (LAST) 


LBCZ  -=  LBCS  (LAST) 
KLOOP  =  KLOOP+1 
LAST  =  LAST-1 
GO  TO  70 
END  IF 


IF  (.NOT.  FLPHD)  GO  TO  1299 


. . .  SCORE  PULSE -HEIGHT  DISTRIBUTION 


EABST  =  CZERO 

DO  100  LS=LPHDB, LPHDE 

EABST  *r  EABST+PHDD  ( LS ) 

100  PHDD(LS)  »  CZERO 

DO  110  JS=1,JSMAX 

IF ( SMARK ( JS )  .LE.  EABST)  GO  TO  120 
110  CONTINUE 

NPHD  =  NPHD+1 
GO  TO  1299 

120  ABE { JS)  *  ABE { JS) +CWCF 
1299  IF (NINDV. EQ . 0) GO  TO  130 

DO  1298  NIND= 1 , NINDV 

EDTL (NIND) =EDPR (NIND) +EDNK (NIND) +EDSC (NIND) 

1298  CONTINUE 

WRITE (44) (EDPR(NIND) , EDNK (NIND) , EDS C (NIND) , EDTL (NIND) , NIND 
$  “1 ,  NINDV) 

130  CONTINUE 
C 

CALL  RANSAV (IRC) 


RETURN 

END 
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Appendix  8 

MCNPX  Source  Subroutine  for 
PASP  Dome  D3 


7 


j 


c_deck  so  source 

subroutine  source 

c  user  supplied  source  subroutine 
#include  "cm.h" 
c 
c 
c 

c  This  is  the  source  routine  for  the  Dome3  dosimeter, 

c  Electron  source  covers  the  top  of  the  aluminum  dome . 

c  The  name  of  this  deck  is  sourcd3.F 

c 

dimension  specin (11) , esp (11) 

data  specin/1. 0  , .9553, . 9062, .8559, .8046, .7508, .6932, .6312, 
$.5627, .4573,0./ 

data  esp/10 . ,  9 . 2, 9.1, 9 . , 8 . 9, 8 . 6, 8 . 3, 8 . , 7 . 5,  5 . ,  0./ 
data  shlrad, twopie/1 .7958, 6 . 2831853/ 
wgt=l. 0 
tme=0 . 0 
jsu=16 
icl=14 
c 

c  The  source  energy 

erg=10 . 0 
ra=rang() 
do  14  jhist-2,11 
if (ra.gt. specin (j hist) ) go  to  16 
14  continue 

16  erg=  esp  (jhist-1)  +  (ra-specin(  jhist-1)  )*  (esp  (jhist)  - 
$esp  ( jhist-1) )  /  (specin  (jhist)  -specin  (jhist-1) ) 
c 

c  ipt=3  denotes  electron  source.  To  change  to  protons, 

c  set  ipt=9 

c 

ipt=3 

stth=rang ( ) 

ct th=sqrt ( 1 . - stth*  stth) 
pph=twopie*rang ( ) 
cpph=cos  (pph) 
spph=sin(pph) 
al=stth*cpph 
bt=stth*spph 
xxx=shlrad*al 
yyy = shl r ad  *bt 
z  z  z = shl rad* c 1 1 h 
10  phs=twopie*rang ( ) 

ths=0 . 5*twopie*rang ( ) 
cths=cos (ths) 
sths=sqrt (1. -cths*cths) 
sphs=sin(phs) 
cphs=cos (phs) 
uuu=sths*cphs 
vw=sths*sphs 
www=cths 

aa=sqrt  (uuu**2+vw**2+vww**2) 

uuu=uuu/aa 

vw=wv/aa 

www = www / aa 

prod=al*uuu+bt*vw+ctth*www 
if (prod . gt . 0) go  to  10 
do  50  ispr=l,3 
50  spare (ispr) =0 . 0 
return 
end 


so  1 

so  2 


so  13 
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